Parent Directory
| 
Revision Log
| 
Patch
| projs/trunk/shared_source/tclxtens/arblenints.c revision 42 by dashley, Fri Oct 14 01:50:00 2016 UTC | projs/dtats/trunk/shared_source/c_tclxtens_7_5/arblenints.c revision 98 by dashley, Sun Dec 18 00:57:31 2016 UTC | |
|---|---|---|
| # | Line 1 | Line 1 |
| 1 | /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tclxtens/arblenints.c,v 1.12 2001/08/18 09:47:00 dtashley Exp $ */ | //$Header$ |
| 2 | //------------------------------------------------------------------------------------------------- | |
| 3 | //-------------------------------------------------------------------------------- | //This file is part of "David T. Ashley's Shared Source Code", a set of shared components |
| 4 | //Copyright 2001 David T. Ashley | //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 GNU GENERAL | //This source code and any program in which it is compiled/used is provided under the MIT License, |
| 7 | //PUBLIC LICENSE, Version 3, full license text below. | //reproduced below. |
| 8 | //------------------------------------------------------------------------------------------------- | //------------------------------------------------------------------------------------------------- |
| 9 | // GNU GENERAL PUBLIC LICENSE | //Permission is hereby granted, free of charge, to any person obtaining a copy of |
| 10 | // Version 3, 29 June 2007 | //this software and associated documentation files(the "Software"), to deal in the |
| 11 | // | //Software without restriction, including without limitation the rights to use, |
| 12 | // Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> | //copy, modify, merge, publish, distribute, sublicense, and / or sell copies of the |
| 13 | // Everyone is permitted to copy and distribute verbatim copies | //Software, and to permit persons to whom the Software is furnished to do so, |
| 14 | // of this license document, but changing it is not allowed. | //subject to the following conditions : |
| 15 | // | // |
| 16 | // Preamble | //The above copyright notice and this permission notice shall be included in all |
| 17 | // | //copies or substantial portions of the Software. |
| 18 | // The GNU General Public License is a free, copyleft license for | // |
| 19 | //software and other kinds of works. | //THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
| 20 | // | //IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
| 21 | // The licenses for most software and other practical works are designed | //FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.IN NO EVENT SHALL THE |
| 22 | //to take away your freedom to share and change the works. By contrast, | //AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
| 23 | //the GNU General Public License is intended to guarantee your freedom to | //LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
| 24 | //share and change all versions of a program--to make sure it remains free | //OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
| 25 | //software for all its users. We, the Free Software Foundation, use the | //SOFTWARE. |
| 26 | //GNU General Public License for most of our software; it applies also to | //------------------------------------------------------------------------------------------------- |
| 27 | //any other work released this way by its authors. You can apply it to | #define MODULE_ARBLENINTS |
| 28 | //your programs, too. | |
| 29 | // | #include <assert.h> |
| 30 | // When we speak of free software, we are referring to freedom, not | #include <string.h> |
| 31 | //price. Our General Public Licenses are designed to make sure that you | |
| 32 | //have the freedom to distribute copies of free software (and charge for | #include "tcl.h" |
| 33 | //them if you wish), that you receive source code or can get it if you | #include "tcldecls.h" |
| 34 | //want it, that you can change the software or use pieces of it in new | |
| 35 | //free programs, and that you know you can do these things. | #include "arblenints.h" |
| 36 | // | #include "bstrfunc.h" |
| 37 | // To protect your rights, we need to prevent others from denying you | #include "extninit.h" |
| 38 | //these rights or asking you to surrender the rights. Therefore, you have | #include "gmp_ints.h" |
| 39 | //certain responsibilities if you distribute copies of the software, or if | #include "gmp_rats.h" |
| 40 | //you modify it: responsibilities to respect the freedom of others. | #include "gmp_ralg.h" |
| 41 | // | #include "intfunc.h" |
| 42 | // For example, if you distribute copies of such a program, whether | #include "tclalloc.h" |
| 43 | //gratis or for a fee, you must pass on to the recipients the same | |
| 44 | //freedoms that you received. You must make sure that they, too, receive | |
| 45 | //or can get the source code. And you must show them these terms so they | //Handles the "cfbrapab" subextension. |
| 46 | //know their rights. | //08/16/01: Visual inspection OK. |
| 47 | // | static |
| 48 | // Developers that use the GNU GPL protect your rights with two steps: | int ARBLENINTS_cfbrapab_handler(ClientData dummy, |
| 49 | //(1) assert copyright on the software, and (2) offer you this License | Tcl_Interp *interp, |
| 50 | //giving you legal permission to copy, distribute and/or modify it. | int objc, |
| 51 | // | Tcl_Obj *objv[]) |
| 52 | // For the developers' and authors' protection, the GPL clearly explains | { |
| 53 | //that there is no warranty for this free software. For both users' and | Tcl_Obj *rv; |
| 54 | //authors' sake, the GPL requires that modified versions be marked as | |
| 55 | //changed, so that their problems will not be attributed erroneously to | //We must have at least two additional arguments |
| 56 | //authors of previous versions. | //to this extension. |
| 57 | // | if (objc < 4) |
| 58 | // Some devices are designed to deny users access to install or run | { |
| 59 | //modified versions of the software inside them, although the manufacturer | Tcl_WrongNumArgs(interp, |
| 60 | //can do so. This is fundamentally incompatible with the aim of | 2, |
| 61 | //protecting users' freedom to change the software. The systematic | objv, |
| 62 | //pattern of such abuse occurs in the area of products for individuals to | "srn uint_kmax ?uint_hmax? ?options?"); |
| 63 | //use, which is precisely where it is most unacceptable. Therefore, we | return(TCL_ERROR); |
| 64 | //have designed this version of the GPL to prohibit the practice for those | } |
| 65 | //products. If such problems arise substantially in other domains, we | else |
| 66 | //stand ready to extend this provision to those domains in future versions | { |
| 67 | //of the GPL, as needed to protect the freedom of users. | char *input_arg; |
| 68 | // | int failure, first_dashed_parameter; |
| 69 | // Finally, every program is threatened constantly by software patents. | char *string_result; |
| 70 | //States should not allow patents to restrict development and use of | int string_result_n_allocd; |
| 71 | //software on general-purpose computers, but in those that do, we wish to | int chars_reqd; |
| 72 | //avoid the special danger that patents applied to a free program could | int i; |
| 73 | //make it effectively proprietary. To prevent this, the GPL assures that | int pred_option_specified = 0; |
| 74 | //patents cannot be used to render the program non-free. | int succ_option_specified = 0; |
| 75 | // | int neversmaller_option_specified = 0; |
| 76 | // The precise terms and conditions for copying, distribution and | int neverlarger_option_specified = 0; |
| 77 | //modification follow. | int n_option_specified = 0; |
| 78 | // | unsigned n = 0; |
| 79 | // TERMS AND CONDITIONS | |
| 80 | // | GMP_RATS_mpq_struct q_rn; |
| 81 | // 0. Definitions. | GMP_INTS_mpz_struct z_kmax; |
| 82 | // | GMP_INTS_mpz_struct z_hmax; |
| 83 | // "This License" refers to version 3 of the GNU General Public License. | |
| 84 | // | //Allocate dynamic memory. |
| 85 | // "Copyright" also means copyright-like laws that apply to other kinds of | GMP_RATS_mpq_init(&q_rn); |
| 86 | //works, such as semiconductor masks. | GMP_INTS_mpz_init(&z_kmax); |
| 87 | // | GMP_INTS_mpz_init(&z_hmax); |
| 88 | // "The Program" refers to any copyrightable work licensed under this | |
| 89 | //License. Each licensee is addressed as "you". "Licensees" and | //Grab a pointer to the string representation of |
| 90 | //"recipients" may be individuals or organizations. | //the first input argument. The storage does not belong to us. |
| 91 | // | input_arg = Tcl_GetString(objv[2]); |
| 92 | // To "modify" a work means to copy from or adapt all or part of the work | assert(input_arg != NULL); |
| 93 | //in a fashion requiring copyright permission, other than the making of an | |
| 94 | //exact copy. The resulting work is called a "modified version" of the | //Try to parse our first input string as a rational number. |
| 95 | //earlier work or a work "based on" the earlier work. | //If we are not successful in this, must abort. |
| 96 | // | GMP_RATS_mpq_set_all_format_rat_num(input_arg, |
| 97 | // A "covered work" means either the unmodified Program or a work based | &failure, |
| 98 | //on the Program. | &q_rn); |
| 99 | // | |
| 100 | // To "propagate" a work means to do anything with it that, without | if (failure) |
| 101 | //permission, would make you directly or secondarily liable for | { |
| 102 | //infringement under applicable copyright law, except executing it on a | rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1); |
| 103 | //computer or modifying a private copy. Propagation includes copying, | Tcl_AppendToObj(rv, input_arg, -1); |
| 104 | //distribution (with or without modification), making available to the | |
| 105 | //public, and in some countries other activities as well. | Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1); |
| 106 | // | Tcl_SetObjResult(interp, rv); |
| 107 | // To "convey" a work means any kind of propagation that enables other | |
| 108 | //parties to make or receive copies. Mere interaction with a user through | GMP_RATS_mpq_clear(&q_rn); |
| 109 | //a computer network, with no transfer of a copy, is not conveying. | GMP_INTS_mpz_clear(&z_kmax); |
| 110 | // | GMP_INTS_mpz_clear(&z_hmax); |
| 111 | // An interactive user interface displays "Appropriate Legal Notices" | |
| 112 | //to the extent that it includes a convenient and prominently visible | return(TCL_ERROR); |
| 113 | //feature that (1) displays an appropriate copyright notice, and (2) | } |
| 114 | //tells the user that there is no warranty for the work (except to the | |
| 115 | //extent that warranties are provided), that licensees may convey the | //Try to parse our next argument as an integer, which |
| 116 | //work under this License, and how to view a copy of this License. If | //will be KMAX. This must be specified. |
| 117 | //the interface presents a list of user commands or options, such as a | // |
| 118 | //menu, a prominent item in the list meets this criterion. | //Get string pointer. Storage does not belong to us. |
| 119 | // | input_arg = Tcl_GetString(objv[3]); |
| 120 | // 1. Source Code. | assert(input_arg != NULL); |
| 121 | // | |
| 122 | // The "source code" for a work means the preferred form of the work | //Try to convert KMAX to an integer. Fatal if an error, |
| 123 | //for making modifications to it. "Object code" means any non-source | //and fatal if the argument is zero or negative. |
| 124 | //form of a work. | GMP_INTS_mpz_set_general_int(&z_kmax, &failure, input_arg); |
| 125 | // | |
| 126 | // A "Standard Interface" means an interface that either is an official | //If there was a parse failure or if the integer is zero |
| 127 | //standard defined by a recognized standards body, or, in the case of | //or negative, must flag error. |
| 128 | //interfaces specified for a particular programming language, one that | if (failure || GMP_INTS_mpz_is_neg(&z_kmax) || GMP_INTS_mpz_is_zero(&z_kmax)) |
| 129 | //is widely used among developers working in that language. | { |
| 130 | // | rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1); |
| 131 | // The "System Libraries" of an executable work include anything, other | Tcl_AppendToObj(rv, input_arg, -1); |
| 132 | //than the work as a whole, that (a) is included in the normal form of | Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1); |
| 133 | //packaging a Major Component, but which is not part of that Major | Tcl_SetObjResult(interp, rv); |
| 134 | //Component, and (b) serves only to enable use of the work with that | |
| 135 | //Major Component, or to implement a Standard Interface for which an | GMP_RATS_mpq_clear(&q_rn); |
| 136 | //implementation is available to the public in source code form. A | GMP_INTS_mpz_clear(&z_kmax); |
| 137 | //"Major Component", in this context, means a major essential component | GMP_INTS_mpz_clear(&z_hmax); |
| 138 | //(kernel, window system, and so on) of the specific operating system | |
| 139 | //(if any) on which the executable work runs, or a compiler used to | return(TCL_ERROR); |
| 140 | //produce the work, or an object code interpreter used to run it. | } |
| 141 | // | |
| 142 | // The "Corresponding Source" for a work in object code form means all | //We need to look for HMAX as the next parameter, if it exists. |
| 143 | //the source code needed to generate, install, and (for an executable | //The way we will figure this out is by whether the |
| 144 | //work) run the object code and to modify the work, including scripts to | //parameter begins with a "-" or not. |
| 145 | //control those activities. However, it does not include the work's | if (objc >= 5) |
| 146 | //System Libraries, or general-purpose tools or generally available free | { |
| 147 | //programs which are used unmodified in performing those activities but | input_arg = Tcl_GetString(objv[4]); |
| 148 | //which are not part of the work. For example, Corresponding Source | assert(input_arg != NULL); |
| 149 | //includes interface definition files associated with source files for | |
| 150 | //the work, and the source code for shared libraries and dynamically | if (input_arg[0] == '-') |
| 151 | //linked subprograms that the work is specifically designed to require, | { |
| 152 | //such as by intimate data communication or control flow between those | first_dashed_parameter = 4; |
| 153 | //subprograms and other parts of the work. | } |
| 154 | // | else |
| 155 | // The Corresponding Source need not include anything that users | { |
| 156 | //can regenerate automatically from other parts of the Corresponding | first_dashed_parameter = 5; |
| 157 | //Source. | } |
| 158 | // | } |
| 159 | // The Corresponding Source for a work in source code form is that | else |
| 160 | //same work. | { |
| 161 | // | first_dashed_parameter = 4; |
| 162 | // 2. Basic Permissions. | } |
| 163 | // | |
| 164 | // All rights granted under this License are granted for the term of | //If there is another parameter and it |
| 165 | //copyright on the Program, and are irrevocable provided the stated | //doesn't begin with a dash, try to parse |
| 166 | //conditions are met. This License explicitly affirms your unlimited | //it as HMAX. We don't explicitly record whether |
| 167 | //permission to run the unmodified Program. The output from running a | //HMAX is specified, because zero is a signal |
| 168 | //covered work is covered by this License only if the output, given its | //when calculating Farey neighbors that HMAX isn't |
| 169 | //content, constitutes a covered work. This License acknowledges your | //to be considered. |
| 170 | //rights of fair use or other equivalent, as provided by copyright law. | if ((objc >= 5) && (first_dashed_parameter == 5)) |
| 171 | // | { |
| 172 | // You may make, run and propagate covered works that you do not | //Get string pointer. Storage does not belong to us. |
| 173 | //convey, without conditions so long as your license otherwise remains | input_arg = Tcl_GetString(objv[4]); |
| 174 | //in force. You may convey covered works to others for the sole purpose | assert(input_arg != NULL); |
| 175 | //of having them make modifications exclusively for you, or provide you | |
| 176 | //with facilities for running those works, provided that you comply with | //Try to convert HMAX to an integer. Fatal if an error, |
| 177 | //the terms of this License in conveying all material for which you do | //and fatal if the argument is zero or negative. |
| 178 | //not control copyright. Those thus making or running the covered works | GMP_INTS_mpz_set_general_int(&z_hmax, &failure, input_arg); |
| 179 | //for you must do so exclusively on your behalf, under your direction | |
| 180 | //and control, on terms that prohibit them from making any copies of | //If there was a parse failure or if the integer is zero |
| 181 | //your copyrighted material outside their relationship with you. | //or negative, must flag error. |
| 182 | // | if (failure || GMP_INTS_mpz_is_neg(&z_hmax) || GMP_INTS_mpz_is_zero(&z_hmax)) |
| 183 | // Conveying under any other circumstances is permitted solely under | { |
| 184 | //the conditions stated below. Sublicensing is not allowed; section 10 | rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1); |
| 185 | //makes it unnecessary. | Tcl_AppendToObj(rv, input_arg, -1); |
| 186 | // | Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1); |
| 187 | // 3. Protecting Users' Legal Rights From Anti-Circumvention Law. | Tcl_SetObjResult(interp, rv); |
| 188 | // | |
| 189 | // No covered work shall be deemed part of an effective technological | GMP_RATS_mpq_clear(&q_rn); |
| 190 | //measure under any applicable law fulfilling obligations under article | GMP_INTS_mpz_clear(&z_kmax); |
| 191 | //11 of the WIPO copyright treaty adopted on 20 December 1996, or | GMP_INTS_mpz_clear(&z_hmax); |
| 192 | //similar laws prohibiting or restricting circumvention of such | |
| 193 | //measures. | return(TCL_ERROR); |
| 194 | // | } |
| 195 | // When you convey a covered work, you waive any legal power to forbid | } |
| 196 | //circumvention of technological measures to the extent such circumvention | |
| 197 | //is effected by exercising rights under this License with respect to | //Process all of the dashed command-line arguments. |
| 198 | //the covered work, and you disclaim any intention to limit operation or | //This involves iterating through all of the |
| 199 | //modification of the work as a means of enforcing, against the work's | //parameters and processing them. |
| 200 | //users, your or third parties' legal rights to forbid circumvention of | for (i=first_dashed_parameter; i<objc; i++) |
| 201 | //technological measures. | { |
| 202 | // | input_arg = Tcl_GetString(objv[i]); |
| 203 | // 4. Conveying Verbatim Copies. | assert(input_arg != NULL); |
| 204 | // | |
| 205 | // You may convey verbatim copies of the Program's source code as you | if (!strcmp("-pred", input_arg)) |
| 206 | //receive it, in any medium, provided that you conspicuously and | { |
| 207 | //appropriately publish on each copy an appropriate copyright notice; | pred_option_specified = 1; |
| 208 | //keep intact all notices stating that this License and any | } |
| 209 | //non-permissive terms added in accord with section 7 apply to the code; | else if (!strcmp("-succ", input_arg)) |
| 210 | //keep intact all notices of the absence of any warranty; and give all | { |
| 211 | //recipients a copy of this License along with the Program. | succ_option_specified = 1; |
| 212 | // | } |
| 213 | // You may charge any price or no price for each copy that you convey, | else if (!strcmp("-neversmaller", input_arg)) |
| 214 | //and you may offer support or warranty protection for a fee. | { |
| 215 | // | neversmaller_option_specified = 1; |
| 216 | // 5. Conveying Modified Source Versions. | } |
| 217 | // | else if (!strcmp("-neverlarger", input_arg)) |
| 218 | // You may convey a work based on the Program, or the modifications to | { |
| 219 | //produce it from the Program, in the form of source code under the | neverlarger_option_specified = 1; |
| 220 | //terms of section 4, provided that you also meet all of these conditions: | } |
| 221 | // | else if (!strcmp("-n", input_arg)) |
| 222 | // a) The work must carry prominent notices stating that you modified | { |
| 223 | // it, and giving a relevant date. | n_option_specified = 1; |
| 224 | // | |
| 225 | // b) The work must carry prominent notices stating that it is | //If -n was specified, there must be a following |
| 226 | // released under this License and any conditions added under section | //parameter which supplies the integer. First |
| 227 | // 7. This requirement modifies the requirement in section 4 to | //check for existence of an additional parameter. |
| 228 | // "keep intact all notices". | if (i >= (objc - 1)) |
| 229 | // | { |
| 230 | // c) You must license the entire work, as a whole, under this | rv = Tcl_NewStringObj("arbint cfbrapab: -n option specified without following integer.", -1); |
| 231 | // License to anyone who comes into possession of a copy. This | Tcl_SetObjResult(interp, rv); |
| 232 | // License will therefore apply, along with any applicable section 7 | |
| 233 | // additional terms, to the whole of the work, and all its parts, | GMP_RATS_mpq_clear(&q_rn); |
| 234 | // regardless of how they are packaged. This License gives no | GMP_INTS_mpz_clear(&z_kmax); |
| 235 | // permission to license the work in any other way, but it does not | GMP_INTS_mpz_clear(&z_hmax); |
| 236 | // invalidate such permission if you have separately received it. | |
| 237 | // | return(TCL_ERROR); |
| 238 | // d) If the work has interactive user interfaces, each must display | } |
| 239 | // Appropriate Legal Notices; however, if the Program has interactive | |
| 240 | // interfaces that do not display Appropriate Legal Notices, your | //We have at least one additional parameter. Try |
| 241 | // work need not make them do so. | //to parse out the next parameter as the integer |
| 242 | // | //we need for n. |
| 243 | // A compilation of a covered work with other separate and independent | i++; |
| 244 | //works, which are not by their nature extensions of the covered work, | |
| 245 | //and which are not combined with it such as to form a larger program, | input_arg = Tcl_GetString(objv[i]); |
| 246 | //in or on a volume of a storage or distribution medium, is called an | assert(input_arg != NULL); |
| 247 | //"aggregate" if the compilation and its resulting copyright are not | |
| 248 | //used to limit the access or legal rights of the compilation's users | GMP_INTS_mpz_parse_into_uint32(&n, &failure, input_arg); |
| 249 | //beyond what the individual works permit. Inclusion of a covered work | |
| 250 | //in an aggregate does not cause this License to apply to the other | //If the parse was unsuccessful, terminate. |
| 251 | //parts of the aggregate. | if (failure) |
| 252 | // | { |
| 253 | // 6. Conveying Non-Source Forms. | rv = Tcl_NewStringObj("arbint cfbrapab: -n option followed by invalid integer.", -1); |
| 254 | // | Tcl_SetObjResult(interp, rv); |
| 255 | // You may convey a covered work in object code form under the terms | |
| 256 | //of sections 4 and 5, provided that you also convey the | GMP_RATS_mpq_clear(&q_rn); |
| 257 | //machine-readable Corresponding Source under the terms of this License, | GMP_INTS_mpz_clear(&z_kmax); |
| 258 | //in one of these ways: | GMP_INTS_mpz_clear(&z_hmax); |
| 259 | // | |
| 260 | // a) Convey the object code in, or embodied in, a physical product | return(TCL_ERROR); |
| 261 | // (including a physical distribution medium), accompanied by the | } |
| 262 | // Corresponding Source fixed on a durable physical medium | |
| 263 | // customarily used for software interchange. | //Clip the integer into a 24-bit quantity. |
| 264 | // | n &= 0x00FFFFFF; |
| 265 | // b) Convey the object code in, or embodied in, a physical product | } |
| 266 | // (including a physical distribution medium), accompanied by a | else |
| 267 | // written offer, valid for at least three years and valid for as | { |
| 268 | // long as you offer spare parts or customer support for that product | //Unrecognized option. Crash out. |
| 269 | // model, to give anyone who possesses the object code either (1) a | rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1); |
| 270 | // copy of the Corresponding Source for all the software in the | Tcl_AppendToObj(rv, input_arg, -1); |
| 271 | // product that is covered by this License, on a durable physical | Tcl_AppendToObj(rv, "\" is not a recognized option.", -1); |
| 272 | // medium customarily used for software interchange, for a price no | Tcl_SetObjResult(interp, rv); |
| 273 | // more than your reasonable cost of physically performing this | |
| 274 | // conveying of source, or (2) access to copy the | GMP_RATS_mpq_clear(&q_rn); |
| 275 | // Corresponding Source from a network server at no charge. | GMP_INTS_mpz_clear(&z_kmax); |
| 276 | // | GMP_INTS_mpz_clear(&z_hmax); |
| 277 | // c) Convey individual copies of the object code with a copy of the | |
| 278 | // written offer to provide the Corresponding Source. This | return(TCL_ERROR); |
| 279 | // alternative is allowed only occasionally and noncommercially, and | } |
| 280 | // only if you received the object code with such an offer, in accord | } |
| 281 | // with subsection 6b. | |
| 282 | // | //Look for any mutually exclusive options. Give a catchall if any of |
| 283 | // d) Convey the object code by offering access from a designated | //them specified. Because we set them all to 1, addition is the easiest |
| 284 | // place (gratis or for a charge), and offer equivalent access to the | //way to do this. |
| 285 | // Corresponding Source in the same way through the same place at no | if ((pred_option_specified + succ_option_specified + neversmaller_option_specified |
| 286 | // further charge. You need not require recipients to copy the | + neverlarger_option_specified + n_option_specified) > 1) |
| 287 | // Corresponding Source along with the object code. If the place to | { |
| 288 | // copy the object code is a network server, the Corresponding Source | rv = Tcl_NewStringObj("arbint cfbrapab: -pred, -succ, -neversmaller, -neverlarger, and -n are mutually exclusive options.", -1); |
| 289 | // may be on a different server (operated by you or a third party) | Tcl_SetObjResult(interp, rv); |
| 290 | // that supports equivalent copying facilities, provided you maintain | |
| 291 | // clear directions next to the object code saying where to find the | GMP_RATS_mpq_clear(&q_rn); |
| 292 | // Corresponding Source. Regardless of what server hosts the | GMP_INTS_mpz_clear(&z_kmax); |
| 293 | // Corresponding Source, you remain obligated to ensure that it is | GMP_INTS_mpz_clear(&z_hmax); |
| 294 | // available for as long as needed to satisfy these requirements. | |
| 295 | // | return(TCL_ERROR); |
| 296 | // e) Convey the object code using peer-to-peer transmission, provided | } |
| 297 | // you inform other peers where the object code and Corresponding | |
| 298 | // Source of the work are being offered to the general public at no | //Split into cases based on what we're doing. This is wasteful of code, |
| 299 | // charge under subsection 6d. | //but this is a PC application, not an embedded application. In all cases |
| 300 | // | //create a hard error if something goes wrong. Any anomalies should trash |
| 301 | // A separable portion of the object code, whose source code is excluded | //a script. |
| 302 | //from the Corresponding Source as a System Library, need not be | if (!pred_option_specified && !succ_option_specified && !n_option_specified) |
| 303 | //included in conveying the object code work. | { |
| 304 | // | //This is the traditional best approximation case, with the possibility of |
| 305 | // A "User Product" is either (1) a "consumer product", which means any | //the -neverlarger or -neversmaller being specified. This is the most messy |
| 306 | //tangible personal property which is normally used for personal, family, | //of all the cases. We must gather neighbors and figure out which is closer, |
| 307 | //or household purposes, or (2) anything designed or sold for incorporation | //and if there is a tie, which has the smaller magnitude. It is fairly |
| 308 | //into a dwelling. In determining whether a product is a consumer product, | //messy. |
| 309 | //doubtful cases shall be resolved in favor of coverage. For a particular | GMP_RALG_fab_neighbor_collection_struct neighbor_data; |
| 310 | //product received by a particular user, "normally used" refers to a | GMP_RATS_mpq_struct left_neigh, right_neigh, diff_left, diff_right, closer_neighbor; |
| 311 | //typical or common use of that class of product, regardless of the status | int dist_cmp; |
| 312 | //of the particular user or of the way in which the particular user | int mag_cmp; |
| 313 | //actually uses, or expects or is expected to use, the product. A product | |
| 314 | //is a consumer product regardless of whether the product has substantial | //Allocate inner dynamic variables. |
| 315 | //commercial, industrial or non-consumer uses, unless such uses represent | GMP_RATS_mpq_init(&left_neigh); |
| 316 | //the only significant mode of use of the product. | GMP_RATS_mpq_init(&right_neigh); |
| 317 | // | GMP_RATS_mpq_init(&diff_left); |
| 318 | // "Installation Information" for a User Product means any methods, | GMP_RATS_mpq_init(&diff_right); |
| 319 | //procedures, authorization keys, or other information required to install | GMP_RATS_mpq_init(&closer_neighbor); |
| 320 | //and execute modified versions of a covered work in that User Product from | |
| 321 | //a modified version of its Corresponding Source. The information must | //Form up the neighbor data. We're only looking for up to one neighbor on each |
| 322 | //suffice to ensure that the continued functioning of the modified object | //side. |
| 323 | //code is in no case prevented or interfered with solely because | GMP_RALG_consecutive_fab_terms( |
| 324 | //modification has been made. | &q_rn, |
| 325 | // | &z_kmax, |
| 326 | // If you convey an object code work under this section in, or with, or | &z_hmax, |
| 327 | //specifically for use in, a User Product, and the conveying occurs as | 1, |
| 328 | //part of a transaction in which the right of possession and use of the | 1, |
| 329 | //User Product is transferred to the recipient in perpetuity or for a | &neighbor_data |
| 330 | //fixed term (regardless of how the transaction is characterized), the | ); |
| 331 | //Corresponding Source conveyed under this section must be accompanied | |
| 332 | //by the Installation Information. But this requirement does not apply | //If there was an error or we couldn't get any neighbors to play with, give |
| 333 | //if neither you nor any third party retains the ability to install | //an error return. As long as we have one neighbor on either side, we can definitely |
| 334 | //modified object code on the User Product (for example, the work has | //complete. |
| 335 | //been installed in ROM). | if (neighbor_data.error || (!neighbor_data.equality && (!neighbor_data.n_left_out || !neighbor_data.n_right_out))) |
| 336 | // | { |
| 337 | // The requirement to provide Installation Information does not include a | rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1); |
| 338 | //requirement to continue to provide support service, warranty, or updates | Tcl_SetObjResult(interp, rv); |
| 339 | //for a work that has been modified or installed by the recipient, or for | |
| 340 | //the User Product in which it has been modified or installed. Access to a | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); |
| 341 | //network may be denied when the modification itself materially and | GMP_RATS_mpq_clear(&q_rn); |
| 342 | //adversely affects the operation of the network or violates the rules and | GMP_INTS_mpz_clear(&z_kmax); |
| 343 | //protocols for communication across the network. | GMP_INTS_mpz_clear(&z_hmax); |
| 344 | // | |
| 345 | // Corresponding Source conveyed, and Installation Information provided, | GMP_RATS_mpq_clear(&left_neigh); |
| 346 | //in accord with this section must be in a format that is publicly | GMP_RATS_mpq_clear(&right_neigh); |
| 347 | //documented (and with an implementation available to the public in | GMP_RATS_mpq_clear(&diff_left); |
| 348 | //source code form), and must require no special password or key for | GMP_RATS_mpq_clear(&diff_right); |
| 349 | //unpacking, reading or copying. | GMP_RATS_mpq_clear(&closer_neighbor); |
| 350 | // | |
| 351 | // 7. Additional Terms. | return(TCL_ERROR); |
| 352 | // | } |
| 353 | // "Additional permissions" are terms that supplement the terms of this | |
| 354 | //License by making exceptions from one or more of its conditions. | if (neighbor_data.equality) |
| 355 | //Additional permissions that are applicable to the entire Program shall | { |
| 356 | //be treated as though they were included in this License, to the extent | //The equality case takes precedence, always. |
| 357 | //that they are valid under applicable law. If additional permissions | GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.norm_rn)); |
| 358 | //apply only to part of the Program, that part may be used separately | } |
| 359 | //under those permissions, but the entire Program remains governed by | else |
| 360 | //this License without regard to the additional permissions. | { |
| 361 | // | //The boolean test somewhat above guaranteed that we have both left |
| 362 | // When you convey a copy of a covered work, you may at your option | //and right neighbors. We can assume this. |
| 363 | //remove any additional permissions from that copy, or from any part of | GMP_RATS_mpq_copy(&left_neigh, &(neighbor_data.lefts[0].neighbor)); |
| 364 | //it. (Additional permissions may be written to require their own | GMP_RATS_mpq_copy(&right_neigh, &(neighbor_data.rights[0].neighbor)); |
| 365 | //removal in certain cases when you modify the work.) You may place | |
| 366 | //additional permissions on material, added by you to a covered work, | GMP_RATS_mpq_sub(&diff_left, &left_neigh, &(neighbor_data.norm_rn)); |
| 367 | //for which you have or can give appropriate copyright permission. | GMP_RATS_mpq_sub(&diff_right, &right_neigh, &(neighbor_data.norm_rn)); |
| 368 | // | GMP_INTS_mpz_abs(&(diff_left.num)); |
| 369 | // Notwithstanding any other provision of this License, for material you | GMP_INTS_mpz_abs(&(diff_right.num)); |
| 370 | //add to a covered work, you may (if authorized by the copyright holders of | dist_cmp = GMP_RATS_mpq_cmp(&diff_left, &diff_right, NULL); |
| 371 | //that material) supplement the terms of this License with terms: | |
| 372 | // | //If we have a tie on the distance, will need to revert to magnitude of the neighbors. |
| 373 | // a) Disclaiming warranty or limiting liability differently from the | GMP_INTS_mpz_abs(&(left_neigh.num)); |
| 374 | // terms of sections 15 and 16 of this License; or | GMP_INTS_mpz_abs(&(right_neigh.num)); |
| 375 | // | mag_cmp = GMP_RATS_mpq_cmp(&left_neigh, &right_neigh, NULL); |
| 376 | // b) Requiring preservation of specified reasonable legal notices or | |
| 377 | // author attributions in that material or in the Appropriate Legal | if (!neversmaller_option_specified |
| 378 | // Notices displayed by works containing it; or | && |
| 379 | // | (neverlarger_option_specified || (dist_cmp < 0) || ((dist_cmp==0) && (mag_cmp < 0)))) |
| 380 | // c) Prohibiting misrepresentation of the origin of that material, or | { |
| 381 | // requiring that modified versions of such material be marked in | GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.lefts[0].neighbor)); |
| 382 | // reasonable ways as different from the original version; or | } |
| 383 | // | else |
| 384 | // d) Limiting the use for publicity purposes of names of licensors or | { |
| 385 | // authors of the material; or | GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.rights[0].neighbor)); |
| 386 | // | } |
| 387 | // e) Declining to grant rights under trademark law for use of some | } |
| 388 | // trade names, trademarks, or service marks; or | |
| 389 | // | //Stuff our variable of choice into a string ... |
| 390 | // f) Requiring indemnification of licensors and authors of that | chars_reqd = INTFUNC_max( |
| 391 | // material by anyone who conveys the material (or modified versions of | GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.num)), |
| 392 | // it) with contractual assumptions of liability to the recipient, for | GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.den)) |
| 393 | // any liability that these contractual assumptions directly impose on | ); |
| 394 | // those licensors and authors. | string_result = TclpAlloc(sizeof(char) * chars_reqd); |
| 395 | // | assert(string_result != NULL); |
| 396 | // All other non-permissive additional terms are considered "further | |
| 397 | //restrictions" within the meaning of section 10. If the Program as you | GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.num)); |
| 398 | //received it, or any part of it, contains a notice stating that it is | rv = Tcl_NewStringObj(string_result, -1); |
| 399 | //governed by this License along with a term that is a further | Tcl_AppendToObj(rv, "/", -1); |
| 400 | //restriction, you may remove that term. If a license document contains | GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.den)); |
| 401 | //a further restriction but permits relicensing or conveying under this | Tcl_AppendToObj(rv, string_result, -1); |
| 402 | //License, you may add to a covered work material governed by the terms | |
| 403 | //of that license document, provided that the further restriction does | Tcl_SetObjResult(interp, rv); |
| 404 | //not survive such relicensing or conveying. | |
| 405 | // | //Deallocate variables, make normal return. |
| 406 | // If you add terms to a covered work in accord with this section, you | TclpFree(string_result); |
| 407 | //must place, in the relevant source files, a statement of the | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); |
| 408 | //additional terms that apply to those files, or a notice indicating | GMP_RATS_mpq_clear(&q_rn); |
| 409 | //where to find the applicable terms. | GMP_INTS_mpz_clear(&z_kmax); |
| 410 | // | GMP_INTS_mpz_clear(&z_hmax); |
| 411 | // Additional terms, permissive or non-permissive, may be stated in the | |
| 412 | //form of a separately written license, or stated as exceptions; | GMP_RATS_mpq_clear(&left_neigh); |
| 413 | //the above requirements apply either way. | GMP_RATS_mpq_clear(&right_neigh); |
| 414 | // | GMP_RATS_mpq_clear(&diff_left); |
| 415 | // 8. Termination. | GMP_RATS_mpq_clear(&diff_right); |
| 416 | // | GMP_RATS_mpq_clear(&closer_neighbor); |
| 417 | // You may not propagate or modify a covered work except as expressly | |
| 418 | //provided under this License. Any attempt otherwise to propagate or | return(TCL_OK); |
| 419 | //modify it is void, and will automatically terminate your rights under | } |
| 420 | //this License (including any patent licenses granted under the third | else if (n_option_specified) |
| 421 | //paragraph of section 11). | { |
| 422 | // | char sbuf[50]; |
| 423 | // However, if you cease all violation of this License, then your | //Static buffer just to stage 32-bit integers. |
| 424 | //license from a particular copyright holder is reinstated (a) | |
| 425 | //provisionally, unless and until the copyright holder explicitly and | //Multiple neighbors. Must iterate through. |
| 426 | //finally terminates your license, and (b) permanently, if the copyright | |
| 427 | //holder fails to notify you of the violation by some reasonable means | GMP_RALG_fab_neighbor_collection_struct neighbor_data; |
| 428 | //prior to 60 days after the cessation. | |
| 429 | // | //Form up the neighbor data. |
| 430 | // Moreover, your license from a particular copyright holder is | GMP_RALG_consecutive_fab_terms( |
| 431 | //reinstated permanently if the copyright holder notifies you of the | &q_rn, |
| 432 | //violation by some reasonable means, this is the first time you have | &z_kmax, |
| 433 | //received notice of violation of this License (for any work) from that | &z_hmax, |
| 434 | //copyright holder, and you cure the violation prior to 30 days after | n, |
| 435 | //your receipt of the notice. | n, |
| 436 | // | &neighbor_data |
| 437 | // Termination of your rights under this section does not terminate the | ); |
| 438 | //licenses of parties who have received copies or rights from you under | |
| 439 | //this License. If your rights have been terminated and not permanently | //If there was an error forming up the neighbor data, create a hard error. |
| 440 | //reinstated, you do not qualify to receive new licenses for the same | if (neighbor_data.error) |
| 441 | //material under section 10. | { |
| 442 | // | rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1); |
| 443 | // 9. Acceptance Not Required for Having Copies. | Tcl_SetObjResult(interp, rv); |
| 444 | // | |
| 445 | // You are not required to accept this License in order to receive or | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); |
| 446 | //run a copy of the Program. Ancillary propagation of a covered work | GMP_RATS_mpq_clear(&q_rn); |
| 447 | //occurring solely as a consequence of using peer-to-peer transmission | GMP_INTS_mpz_clear(&z_kmax); |
| 448 | //to receive a copy likewise does not require acceptance. However, | GMP_INTS_mpz_clear(&z_hmax); |
| 449 | //nothing other than this License grants you permission to propagate or | |
| 450 | //modify any covered work. These actions infringe copyright if you do | return(TCL_ERROR); |
| 451 | //not accept this License. Therefore, by modifying or propagating a | } |
| 452 | //covered work, you indicate your acceptance of this License to do so. | |
| 453 | // | //Allocate a default buffer of 10K for the ASCII representation of integers. |
| 454 | // 10. Automatic Licensing of Downstream Recipients. | //In the vast majority of cases, there will be only one allocation, because it |
| 455 | // | //takes a mean integer to exceed 10K. However, the logic allows it to grow. |
| 456 | // Each time you convey a covered work, the recipient automatically | string_result_n_allocd = 10000; |
| 457 | //receives a license from the original licensors, to run, modify and | string_result = TclpAlloc(sizeof(char) * string_result_n_allocd); |
| 458 | //propagate that work, subject to this License. You are not responsible | assert(string_result != NULL); |
| 459 | //for enforcing compliance by third parties with this License. | |
| 460 | // | //Start off with a return value of the null string. |
| 461 | // An "entity transaction" is a transaction transferring control of an | rv = Tcl_NewStringObj("", -1); |
| 462 | //organization, or substantially all assets of one, or subdividing an | |
| 463 | //organization, or merging organizations. If propagation of a covered | //Loop through, spitting out the left neighbors. |
| 464 | //work results from an entity transaction, each party to that | for (i = neighbor_data.n_left_out-1; i >= 0; i--) |
| 465 | //transaction who receives a copy of the work also receives whatever | { |
| 466 | //licenses to the work the party's predecessor in interest had or could | //The protocol here is everyone spits out one space before |
| 467 | //give under the previous paragraph, plus a right to possession of the | //they print anything. Must skip this on first loop iteration. |
| 468 | //Corresponding Source of the work from the predecessor in interest, if | if (i != neighbor_data.n_left_out-1) |
| 469 | //the predecessor has it or can get it with reasonable efforts. | Tcl_AppendToObj(rv, " ", -1); |
| 470 | // | |
| 471 | // You may not impose any further restrictions on the exercise of the | //The index will be the negative of the iteration variable minus one. |
| 472 | //rights granted or affirmed under this License. For example, you may | sprintf(sbuf, "%d", -i - 1); |
| 473 | //not impose a license fee, royalty, or other charge for exercise of | Tcl_AppendToObj(rv, sbuf, -1); |
| 474 | //rights granted under this License, and you may not initiate litigation | |
| 475 | //(including a cross-claim or counterclaim in a lawsuit) alleging that | //Force the buffer to have enough space for the components of the rational |
| 476 | //any patent claim is infringed by making, using, selling, offering for | //number. |
| 477 | //sale, or importing the Program or any portion of it. | chars_reqd = INTFUNC_max( |
| 478 | // | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.num)), |
| 479 | // 11. Patents. | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.den)) |
| 480 | // | ); |
| 481 | // A "contributor" is a copyright holder who authorizes use under this | if (chars_reqd > string_result_n_allocd) |
| 482 | //License of the Program or a work on which the Program is based. The | { |
| 483 | //work thus licensed is called the contributor's "contributor version". | string_result_n_allocd = chars_reqd; |
| 484 | // | string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd); |
| 485 | // A contributor's "essential patent claims" are all patent claims | assert(string_result != NULL); |
| 486 | //owned or controlled by the contributor, whether already acquired or | } |
| 487 | //hereafter acquired, that would be infringed by some manner, permitted | |
| 488 | //by this License, of making, using, or selling its contributor version, | //Print the rational number out to the Tcl object. |
| 489 | //but do not include claims that would be infringed only as a | Tcl_AppendToObj(rv, " ", -1); |
| 490 | //consequence of further modification of the contributor version. For | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.num)); |
| 491 | //purposes of this definition, "control" includes the right to grant | Tcl_AppendToObj(rv, string_result, -1); |
| 492 | //patent sublicenses in a manner consistent with the requirements of | Tcl_AppendToObj(rv, "/", -1); |
| 493 | //this License. | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.den)); |
| 494 | // | Tcl_AppendToObj(rv, string_result, -1); |
| 495 | // Each contributor grants you a non-exclusive, worldwide, royalty-free | } |
| 496 | //patent license under the contributor's essential patent claims, to | |
| 497 | //make, use, sell, offer for sale, import and otherwise run, modify and | //Spit out the equality case if appropriate. |
| 498 | //propagate the contents of its contributor version. | if (neighbor_data.equality) |
| 499 | // | { |
| 500 | // In the following three paragraphs, a "patent license" is any express | if (neighbor_data.n_left_out) |
| 501 | //agreement or commitment, however denominated, not to enforce a patent | Tcl_AppendToObj(rv, " ", -1); |
| 502 | //(such as an express permission to practice a patent or covenant not to | |
| 503 | //sue for patent infringement). To "grant" such a patent license to a | Tcl_AppendToObj(rv, "0", -1); |
| 504 | //party means to make such an agreement or commitment not to enforce a | |
| 505 | //patent against the party. | //Force the buffer to have enough space for the components of the rational |
| 506 | // | //number. |
| 507 | // If you convey a covered work, knowingly relying on a patent license, | chars_reqd = INTFUNC_max( |
| 508 | //and the Corresponding Source of the work is not available for anyone | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.num)), |
| 509 | //to copy, free of charge and under the terms of this License, through a | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.den)) |
| 510 | //publicly available network server or other readily accessible means, | ); |
| 511 | //then you must either (1) cause the Corresponding Source to be so | if (chars_reqd > string_result_n_allocd) |
| 512 | //available, or (2) arrange to deprive yourself of the benefit of the | { |
| 513 | //patent license for this particular work, or (3) arrange, in a manner | string_result_n_allocd = chars_reqd; |
| 514 | //consistent with the requirements of this License, to extend the patent | string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd); |
| 515 | //license to downstream recipients. "Knowingly relying" means you have | assert(string_result != NULL); |
| 516 | //actual knowledge that, but for the patent license, your conveying the | } |
| 517 | //covered work in a country, or your recipient's use of the covered work | |
| 518 | //in a country, would infringe one or more identifiable patents in that | //Print the rational number out to the Tcl object. |
| 519 | //country that you have reason to believe are valid. | Tcl_AppendToObj(rv, " ", -1); |
| 520 | // | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.num)); |
| 521 | // If, pursuant to or in connection with a single transaction or | Tcl_AppendToObj(rv, string_result, -1); |
| 522 | //arrangement, you convey, or propagate by procuring conveyance of, a | Tcl_AppendToObj(rv, "/", -1); |
| 523 | //covered work, and grant a patent license to some of the parties | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.den)); |
| 524 | //receiving the covered work authorizing them to use, propagate, modify | Tcl_AppendToObj(rv, string_result, -1); |
| 525 | //or convey a specific copy of the covered work, then the patent license | } |
| 526 | //you grant is automatically extended to all recipients of the covered | |
| 527 | //work and works based on it. | //Loop through, spitting out the right neighbors. |
| 528 | // | for (i = 0; i < neighbor_data.n_right_out; i++) |
| 529 | // A patent license is "discriminatory" if it does not include within | { |
| 530 | //the scope of its coverage, prohibits the exercise of, or is | //The protocol here is everyone spits out one space before |
| 531 | //conditioned on the non-exercise of one or more of the rights that are | //they print anything. Must skip this on first loop iteration. |
| 532 | //specifically granted under this License. You may not convey a covered | if (neighbor_data.n_left_out || neighbor_data.equality || i) |
| 533 | //work if you are a party to an arrangement with a third party that is | Tcl_AppendToObj(rv, " ", -1); |
| 534 | //in the business of distributing software, under which you make payment | |
| 535 | //to the third party based on the extent of your activity of conveying | //The index will be the iteration variable plus one. |
| 536 | //the work, and under which the third party grants, to any of the | sprintf(sbuf, "%d", i+1); |
| 537 | //parties who would receive the covered work from you, a discriminatory | Tcl_AppendToObj(rv, sbuf, -1); |
| 538 | //patent license (a) in connection with copies of the covered work | |
| 539 | //conveyed by you (or copies made from those copies), or (b) primarily | //Force the buffer to have enough space for the components of the rational |
| 540 | //for and in connection with specific products or compilations that | //number. |
| 541 | //contain the covered work, unless you entered into that arrangement, | chars_reqd = INTFUNC_max( |
| 542 | //or that patent license was granted, prior to 28 March 2007. | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.num)), |
| 543 | // | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.den)) |
| 544 | // Nothing in this License shall be construed as excluding or limiting | ); |
| 545 | //any implied license or other defenses to infringement that may | if (chars_reqd > string_result_n_allocd) |
| 546 | //otherwise be available to you under applicable patent law. | { |
| 547 | // | string_result_n_allocd = chars_reqd; |
| 548 | // 12. No Surrender of Others' Freedom. | string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd); |
| 549 | // | assert(string_result != NULL); |
| 550 | // If conditions are imposed on you (whether by court order, agreement or | } |
| 551 | //otherwise) that contradict the conditions of this License, they do not | |
| 552 | //excuse you from the conditions of this License. If you cannot convey a | //Print the rational number out to the Tcl object. |
| 553 | //covered work so as to satisfy simultaneously your obligations under this | Tcl_AppendToObj(rv, " ", -1); |
| 554 | //License and any other pertinent obligations, then as a consequence you may | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.num)); |
| 555 | //not convey it at all. For example, if you agree to terms that obligate you | Tcl_AppendToObj(rv, string_result, -1); |
| 556 | //to collect a royalty for further conveying from those to whom you convey | Tcl_AppendToObj(rv, "/", -1); |
| 557 | //the Program, the only way you could satisfy both those terms and this | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.den)); |
| 558 | //License would be to refrain entirely from conveying the Program. | Tcl_AppendToObj(rv, string_result, -1); |
| 559 | // | } |
| 560 | // 13. Use with the GNU Affero General Public License. | |
| 561 | // | //Set up for a normal return. |
| 562 | // Notwithstanding any other provision of this License, you have | Tcl_SetObjResult(interp, rv); |
| 563 | //permission to link or combine any covered work with a work licensed | |
| 564 | //under version 3 of the GNU Affero General Public License into a single | TclpFree(string_result); |
| 565 | //combined work, and to convey the resulting work. The terms of this | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); |
| 566 | //License will continue to apply to the part which is the covered work, | GMP_RATS_mpq_clear(&q_rn); |
| 567 | //but the special requirements of the GNU Affero General Public License, | GMP_INTS_mpz_clear(&z_kmax); |
| 568 | //section 13, concerning interaction through a network will apply to the | GMP_INTS_mpz_clear(&z_hmax); |
| 569 | //combination as such. | |
| 570 | // | return(TCL_OK); |
| 571 | // 14. Revised Versions of this License. | } |
| 572 | // | else if (pred_option_specified) |
| 573 | // The Free Software Foundation may publish revised and/or new versions of | { |
| 574 | //the GNU General Public License from time to time. Such new versions will | //Simple predecessor case. |
| 575 | //be similar in spirit to the present version, but may differ in detail to | |
| 576 | //address new problems or concerns. | GMP_RALG_fab_neighbor_collection_struct neighbor_data; |
| 577 | // | |
| 578 | // Each version is given a distinguishing version number. If the | //Form up the neighbor data. |
| 579 | //Program specifies that a certain numbered version of the GNU General | GMP_RALG_consecutive_fab_terms( |
| 580 | //Public License "or any later version" applies to it, you have the | &q_rn, |
| 581 | //option of following the terms and conditions either of that numbered | &z_kmax, |
| 582 | //version or of any later version published by the Free Software | &z_hmax, |
| 583 | //Foundation. If the Program does not specify a version number of the | 1, |
| 584 | //GNU General Public License, you may choose any version ever published | 0, |
| 585 | //by the Free Software Foundation. | &neighbor_data |
| 586 | // | ); |
| 587 | // If the Program specifies that a proxy can decide which future | |
| 588 | //versions of the GNU General Public License can be used, that proxy's | //If there was an error forming up the neighbor data or there are no left neighbors, |
| 589 | //public statement of acceptance of a version permanently authorizes you | //create a hard error. |
| 590 | //to choose that version for the Program. | if (neighbor_data.error || !neighbor_data.n_left_out) |
| 591 | // | { |
| 592 | // Later license versions may give you additional or different | rv = Tcl_NewStringObj("arbint cfbrapab: unable to find predecessor.", -1); |
| 593 | //permissions. However, no additional obligations are imposed on any | Tcl_SetObjResult(interp, rv); |
| 594 | //author or copyright holder as a result of your choosing to follow a | |
| 595 | //later version. | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); |
| 596 | // | GMP_RATS_mpq_clear(&q_rn); |
| 597 | // 15. Disclaimer of Warranty. | GMP_INTS_mpz_clear(&z_kmax); |
| 598 | // | GMP_INTS_mpz_clear(&z_hmax); |
| 599 | // THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY | |
| 600 | //APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT | return(TCL_ERROR); |
| 601 | //HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY | } |
| 602 | //OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, | |
| 603 | //THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR | //The test above confirmed that we have at least one left neighbor calculated. |
| 604 | //PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM | //We can dump it to a string and finish up. |
| 605 | //IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF | chars_reqd = INTFUNC_max( |
| 606 | //ALL NECESSARY SERVICING, REPAIR OR CORRECTION. | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.num)), |
| 607 | // | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.den)) |
| 608 | // 16. Limitation of Liability. | ); |
| 609 | // | string_result = TclpAlloc(sizeof(char) * chars_reqd); |
| 610 | // IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING | assert(string_result != NULL); |
| 611 | //WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS | |
| 612 | //THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.num)); |
| 613 | //GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE | rv = Tcl_NewStringObj(string_result, -1); |
| 614 | //USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF | Tcl_AppendToObj(rv, "/", -1); |
| 615 | //DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.den)); |
| 616 | //PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), | Tcl_AppendToObj(rv, string_result, -1); |
| 617 | //EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF | |
| 618 | //SUCH DAMAGES. | Tcl_SetObjResult(interp, rv); |
| 619 | // | |
| 620 | // 17. Interpretation of Sections 15 and 16. | TclpFree(string_result); |
| 621 | // | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); |
| 622 | // If the disclaimer of warranty and limitation of liability provided | GMP_RATS_mpq_clear(&q_rn); |
| 623 | //above cannot be given local legal effect according to their terms, | GMP_INTS_mpz_clear(&z_kmax); |
| 624 | //reviewing courts shall apply local law that most closely approximates | GMP_INTS_mpz_clear(&z_hmax); |
| 625 | //an absolute waiver of all civil liability in connection with the | |
| 626 | //Program, unless a warranty or assumption of liability accompanies a | return(TCL_OK); |
| 627 | //copy of the Program in return for a fee. | } |
| 628 | // | else if (succ_option_specified) |
| 629 | // END OF TERMS AND CONDITIONS | { |
| 630 | // | //Simple successor. |
| 631 | // How to Apply These Terms to Your New Programs | |
| 632 | // | GMP_RALG_fab_neighbor_collection_struct neighbor_data; |
| 633 | // If you develop a new program, and you want it to be of the greatest | |
| 634 | //possible use to the public, the best way to achieve this is to make it | //Form up the neighbor data. |
| 635 | //free software which everyone can redistribute and change under these terms. | GMP_RALG_consecutive_fab_terms( |
| 636 | // | &q_rn, |
| 637 | // To do so, attach the following notices to the program. It is safest | &z_kmax, |
| 638 | //to attach them to the start of each source file to most effectively | &z_hmax, |
| 639 | //state the exclusion of warranty; and each file should have at least | 0, |
| 640 | //the "copyright" line and a pointer to where the full notice is found. | 1, |
| 641 | // | &neighbor_data |
| 642 | // <one line to give the program's name and a brief idea of what it does.> | ); |
| 643 | // Copyright (C) <year> <name of author> | |
| 644 | // | //If there was an error forming up the neighbor data or there are no right neighbors, |
| 645 | // This program is free software: you can redistribute it and/or modify | //create a hard error. |
| 646 | // it under the terms of the GNU General Public License as published by | if (neighbor_data.error || !neighbor_data.n_right_out) |
| 647 | // the Free Software Foundation, either version 3 of the License, or | { |
| 648 | // (at your option) any later version. | rv = Tcl_NewStringObj("arbint cfbrapab: unable to find successor.", -1); |
| 649 | // | Tcl_SetObjResult(interp, rv); |
| 650 | // This program is distributed in the hope that it will be useful, | |
| 651 | // but WITHOUT ANY WARRANTY; without even the implied warranty of | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); |
| 652 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | GMP_RATS_mpq_clear(&q_rn); |
| 653 | // GNU General Public License for more details. | GMP_INTS_mpz_clear(&z_kmax); |
| 654 | // | GMP_INTS_mpz_clear(&z_hmax); |
| 655 | // You should have received a copy of the GNU General Public License | |
| 656 | // along with this program. If not, see <http://www.gnu.org/licenses/>. | return(TCL_ERROR); |
| 657 | // | } |
| 658 | //Also add information on how to contact you by electronic and paper mail. | |
| 659 | // | //The test above confirmed that we have at least one right neighbor calculated. |
| 660 | // If the program does terminal interaction, make it output a short | //We can dump it to a string and finish up. |
| 661 | //notice like this when it starts in an interactive mode: | chars_reqd = INTFUNC_max( |
| 662 | // | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.num)), |
| 663 | // <program> Copyright (C) <year> <name of author> | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.den)) |
| 664 | // This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. | ); |
| 665 | // This is free software, and you are welcome to redistribute it | string_result = TclpAlloc(sizeof(char) * chars_reqd); |
| 666 | // under certain conditions; type `show c' for details. | assert(string_result != NULL); |
| 667 | // | |
| 668 | //The hypothetical commands `show w' and `show c' should show the appropriate | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.num)); |
| 669 | //parts of the General Public License. Of course, your program's commands | rv = Tcl_NewStringObj(string_result, -1); |
| 670 | //might be different; for a GUI interface, you would use an "about box". | Tcl_AppendToObj(rv, "/", -1); |
| 671 | // | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.den)); |
| 672 | // You should also get your employer (if you work as a programmer) or school, | Tcl_AppendToObj(rv, string_result, -1); |
| 673 | //if any, to sign a "copyright disclaimer" for the program, if necessary. | |
| 674 | //For more information on this, and how to apply and follow the GNU GPL, see | Tcl_SetObjResult(interp, rv); |
| 675 | //<http://www.gnu.org/licenses/>. | |
| 676 | // | TclpFree(string_result); |
| 677 | // The GNU General Public License does not permit incorporating your program | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); |
| 678 | //into proprietary programs. If your program is a subroutine library, you | GMP_RATS_mpq_clear(&q_rn); |
| 679 | //may consider it more useful to permit linking proprietary applications with | GMP_INTS_mpz_clear(&z_kmax); |
| 680 | //the library. If this is what you want to do, use the GNU Lesser General | GMP_INTS_mpz_clear(&z_hmax); |
| 681 | //Public License instead of this License. But first, please read | |
| 682 | //<http://www.gnu.org/philosophy/why-not-lgpl.html>. | return(TCL_OK); |
| 683 | //------------------------------------------------------------------------------------------------- | } |
| 684 | //-------------------------------------------------------------------------------- | |
| 685 | #define MODULE_ARBLENINTS | //Free up all dynamic memory. |
| 686 | GMP_RATS_mpq_clear(&q_rn); | |
| 687 | #include <assert.h> | GMP_INTS_mpz_clear(&z_kmax); |
| 688 | #include <string.h> | GMP_INTS_mpz_clear(&z_hmax); |
| 689 | ||
| 690 | #include "tcl.h" | //Return |
| 691 | #include "tcldecls.h" | return(TCL_OK); |
| 692 | } | |
| 693 | #include "arblenints.h" | } |
| 694 | #include "bstrfunc.h" | |
| 695 | #include "extninit.h" | |
| 696 | #include "gmp_ints.h" | //Handles the "cfratnum" subextension. |
| 697 | #include "gmp_rats.h" | //08/07/01: Visually inspected, OK. |
| 698 | #include "gmp_ralg.h" | static |
| 699 | #include "intfunc.h" | int ARBLENINTS_cfratnum_handler(ClientData dummy, |
| 700 | #include "tclalloc.h" | Tcl_Interp *interp, |
| 701 | int objc, | |
| 702 | Tcl_Obj *objv[]) | |
| 703 | //Handles the "cfbrapab" subextension. | { |
| 704 | //08/16/01: Visual inspection OK. | Tcl_Obj *rv; |
| 705 | static | |
| 706 | int ARBLENINTS_cfbrapab_handler(ClientData dummy, | //We must have exactly one additional argument |
| 707 | Tcl_Interp *interp, | //to this function, which is the rational number |
| 708 | int objc, | //whose continued fraction decomposition is to be |
| 709 | Tcl_Obj *objv[]) | //calculated. |
| 710 | { | if (objc != 3) |
| 711 | Tcl_Obj *rv; | { |
| 712 | Tcl_WrongNumArgs(interp, | |
| 713 | //We must have at least two additional arguments | 2, |
| 714 | //to this extension. | objv, |
| 715 | if (objc < 4) | "urn"); |
| 716 | { | return(TCL_ERROR); |
| 717 | Tcl_WrongNumArgs(interp, | } |
| 718 | 2, | else |
| 719 | objv, | { |
| 720 | "srn uint_kmax ?uint_hmax? ?options?"); | char *input_arg; |
| 721 | return(TCL_ERROR); | int failure; |
| 722 | } | unsigned chars_reqd; |
| 723 | else | char *string_result; |
| 724 | { | int n_string_result; |
| 725 | char *input_arg; | int i; |
| 726 | int failure, first_dashed_parameter; | GMP_RATS_mpq_struct rn; |
| 727 | char *string_result; | GMP_RALG_cf_app_struct decomp; |
| 728 | int string_result_n_allocd; | |
| 729 | int chars_reqd; | //In this function, we are going to return a string |
| 730 | int i; | //result formed by starting with a string and then |
| 731 | int pred_option_specified = 0; | //concatenating to it again and again. We start |
| 732 | int succ_option_specified = 0; | //off believing that 10,000 characters of space is enough, |
| 733 | int neversmaller_option_specified = 0; | //but we may need to revise upward and reallocate. |
| 734 | int neverlarger_option_specified = 0; | //A 10,000 character block is chosen because it is quick |
| 735 | int n_option_specified = 0; | //to allocate and most times won't go beyond that. |
| 736 | unsigned n = 0; | n_string_result = 10000; |
| 737 | string_result = TclpAlloc(sizeof(char) * n_string_result); | |
| 738 | GMP_RATS_mpq_struct q_rn; | assert(string_result != NULL); |
| 739 | GMP_INTS_mpz_struct z_kmax; | |
| 740 | GMP_INTS_mpz_struct z_hmax; | //We will need a rational number to hold the return value |
| 741 | //from the parsing function. Allocate that now. | |
| 742 | //Allocate dynamic memory. | GMP_RATS_mpq_init(&rn); |
| 743 | GMP_RATS_mpq_init(&q_rn); | |
| 744 | GMP_INTS_mpz_init(&z_kmax); | //Grab a pointer to the string representation of |
| 745 | GMP_INTS_mpz_init(&z_hmax); | //the input argument. The storage does not belong to us. |
| 746 | input_arg = Tcl_GetString(objv[2]); | |
| 747 | //Grab a pointer to the string representation of | assert(input_arg != NULL); |
| 748 | //the first input argument. The storage does not belong to us. | |
| 749 | input_arg = Tcl_GetString(objv[2]); | //Try to parse our input string as a rational number. |
| 750 | assert(input_arg != NULL); | //If we are not successful in this, must abort. |
| 751 | GMP_RATS_mpq_set_all_format_rat_num(input_arg, | |
| 752 | //Try to parse our first input string as a rational number. | &failure, |
| 753 | //If we are not successful in this, must abort. | &rn); |
| 754 | GMP_RATS_mpq_set_all_format_rat_num(input_arg, | |
| 755 | &failure, | if (failure) |
| 756 | &q_rn); | { |
| 757 | rv = Tcl_NewStringObj("arbint cfratnum: \"", -1); | |
| 758 | if (failure) | Tcl_AppendToObj(rv, input_arg, -1); |
| 759 | { | |
| 760 | rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1); | Tcl_AppendToObj(rv, "\" is not a recognized non-negative rational number.", -1); |
| 761 | Tcl_AppendToObj(rv, input_arg, -1); | Tcl_SetObjResult(interp, rv); |
| 762 | ||
| 763 | Tcl_AppendToObj(rv, "\" is not a recognized rational number.", -1); | TclpFree(string_result); |
| 764 | Tcl_SetObjResult(interp, rv); | GMP_RATS_mpq_clear(&rn); |
| 765 | ||
| 766 | GMP_RATS_mpq_clear(&q_rn); | return(TCL_ERROR); |
| 767 | GMP_INTS_mpz_clear(&z_kmax); | } |
| 768 | GMP_INTS_mpz_clear(&z_hmax); | |
| 769 | //OK, we have a rational number, but there is a possibility | |
| 770 | return(TCL_ERROR); | //it is negative, which is a no-no. Normalize the signs |
| 771 | } | //for easier testing. |
| 772 | GMP_RATS_mpq_normalize_sign(&rn); | |
| 773 | //Try to parse our next argument as an integer, which | if (GMP_INTS_mpz_is_neg(&(rn.num))) |
| 774 | //will be KMAX. This must be specified. | { |
| 775 | // | rv = Tcl_NewStringObj("arbint cfratnum: \"", -1); |
| 776 | //Get string pointer. Storage does not belong to us. | Tcl_AppendToObj(rv, input_arg, -1); |
| 777 | input_arg = Tcl_GetString(objv[3]); | |
| 778 | assert(input_arg != NULL); | Tcl_AppendToObj(rv, "\" is negative.", -1); |
| 779 | Tcl_SetObjResult(interp, rv); | |
| 780 | //Try to convert KMAX to an integer. Fatal if an error, | |
| 781 | //and fatal if the argument is zero or negative. | TclpFree(string_result); |
| 782 | GMP_INTS_mpz_set_general_int(&z_kmax, &failure, input_arg); | GMP_RATS_mpq_clear(&rn); |
| 783 | ||
| 784 | //If there was a parse failure or if the integer is zero | return(TCL_ERROR); |
| 785 | //or negative, must flag error. | } |
| 786 | if (failure || GMP_INTS_mpz_is_neg(&z_kmax) || GMP_INTS_mpz_is_zero(&z_kmax)) | |
| 787 | { | //OK, we have a rational number. Form the continued fraction |
| 788 | rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1); | //decomposition of it. The function called is set up so that |
| 789 | Tcl_AppendToObj(rv, input_arg, -1); | //one must deallocate, even in an error condition. |
| 790 | Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1); | GMP_RALG_cfdecomp_init(&decomp, |
| 791 | Tcl_SetObjResult(interp, rv); | &failure, |
| 792 | &(rn.num), | |
| 793 | GMP_RATS_mpq_clear(&q_rn); | &(rn.den)); |
| 794 | GMP_INTS_mpz_clear(&z_kmax); | |
| 795 | GMP_INTS_mpz_clear(&z_hmax); | //If we failed in the decomposition (don't know why that would |
| 796 | //happen) use the general error flag "NAN". | |
| 797 | return(TCL_ERROR); | if (failure) |
| 798 | } | { |
| 799 | rv = Tcl_NewStringObj("NAN", -1); | |
| 800 | //We need to look for HMAX as the next parameter, if it exists. | |
| 801 | //The way we will figure this out is by whether the | Tcl_SetObjResult(interp, rv); |
| 802 | //parameter begins with a "-" or not. | |
| 803 | if (objc >= 5) | TclpFree(string_result); |
| 804 | { | GMP_RATS_mpq_clear(&rn); |
| 805 | input_arg = Tcl_GetString(objv[4]); | GMP_RALG_cfdecomp_destroy(&decomp); |
| 806 | assert(input_arg != NULL); | |
| 807 | return(TCL_ERROR); | |
| 808 | if (input_arg[0] == '-') | } |
| 809 | { | |
| 810 | first_dashed_parameter = 4; | //OK, that really is the last error we could have. |
| 811 | } | //Iterate, adding the partial quotients and convergents |
| 812 | else | //to the string which we'll return. We need to watch out |
| 813 | { | //for running over our 10K buffer. |
| 814 | first_dashed_parameter = 5; | rv = Tcl_NewStringObj("", -1); |
| 815 | } | for (i=0; i<decomp.n; i++) |
| 816 | } | { |
| 817 | else | //Partial quotient. |
| 818 | { | chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.a[i])); |
| 819 | first_dashed_parameter = 4; | if (chars_reqd > (unsigned)n_string_result) |
| 820 | } | { |
| 821 | n_string_result = chars_reqd; | |
| 822 | //If there is another parameter and it | string_result = TclpRealloc(string_result, |
| 823 | //doesn't begin with a dash, try to parse | sizeof(char) * n_string_result); |
| 824 | //it as HMAX. We don't explicitly record whether | } |
| 825 | //HMAX is specified, because zero is a signal | GMP_INTS_mpz_to_string(string_result, &(decomp.a[i])); |
| 826 | //when calculating Farey neighbors that HMAX isn't | Tcl_AppendToObj(rv, string_result, -1); |
| 827 | //to be considered. | Tcl_AppendToObj(rv, " ", -1); |
| 828 | if ((objc >= 5) && (first_dashed_parameter == 5)) | |
| 829 | { | //Numerator of convergent. |
| 830 | //Get string pointer. Storage does not belong to us. | chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.p[i])); |
| 831 | input_arg = Tcl_GetString(objv[4]); | if (chars_reqd > (unsigned)n_string_result) |
| 832 | assert(input_arg != NULL); | { |
| 833 | n_string_result = chars_reqd; | |
| 834 | //Try to convert HMAX to an integer. Fatal if an error, | string_result = TclpRealloc(string_result, |
| 835 | //and fatal if the argument is zero or negative. | sizeof(char) * n_string_result); |
| 836 | GMP_INTS_mpz_set_general_int(&z_hmax, &failure, input_arg); | } |
| 837 | GMP_INTS_mpz_to_string(string_result, &(decomp.p[i])); | |
| 838 | //If there was a parse failure or if the integer is zero | Tcl_AppendToObj(rv, string_result, -1); |
| 839 | //or negative, must flag error. | Tcl_AppendToObj(rv, " ", -1); |
| 840 | if (failure || GMP_INTS_mpz_is_neg(&z_hmax) || GMP_INTS_mpz_is_zero(&z_hmax)) | |
| 841 | { | //Denominator of convergent. |
| 842 | rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1); | chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.q[i])); |
| 843 | Tcl_AppendToObj(rv, input_arg, -1); | if (chars_reqd > (unsigned)n_string_result) |
| 844 | Tcl_AppendToObj(rv, "\" is not a recognized positive integer.", -1); | { |
| 845 | Tcl_SetObjResult(interp, rv); | n_string_result = chars_reqd; |
| 846 | string_result = TclpRealloc(string_result, | |
| 847 | GMP_RATS_mpq_clear(&q_rn); | sizeof(char) * n_string_result); |
| 848 | GMP_INTS_mpz_clear(&z_kmax); | } |
| 849 | GMP_INTS_mpz_clear(&z_hmax); | GMP_INTS_mpz_to_string(string_result, &(decomp.q[i])); |
| 850 | Tcl_AppendToObj(rv, string_result, -1); | |
| 851 | return(TCL_ERROR); | if (i != (decomp.n - 1)) //No space after last number. |
| 852 | } | Tcl_AppendToObj(rv, " ", -1); |
| 853 | } | } |
| 854 | ||
| 855 | //Process all of the dashed command-line arguments. | //Assign the result to be the return value. |
| 856 | //This involves iterating through all of the | Tcl_SetObjResult(interp, rv); |
| 857 | //parameters and processing them. | |
| 858 | for (i=first_dashed_parameter; i<objc; i++) | //Free up all dynamic memory. |
| 859 | { | TclpFree(string_result); |
| 860 | input_arg = Tcl_GetString(objv[i]); | GMP_RATS_mpq_clear(&rn); |
| 861 | assert(input_arg != NULL); | GMP_RALG_cfdecomp_destroy(&decomp); |
| 862 | ||
| 863 | if (!strcmp("-pred", input_arg)) | //Return |
| 864 | { | return(TCL_OK); |
| 865 | pred_option_specified = 1; | } |
| 866 | } | } |
| 867 | else if (!strcmp("-succ", input_arg)) | |
| 868 | { | |
| 869 | succ_option_specified = 1; | //Handles the "commanate" subextension. |
| 870 | } | //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this |
| 871 | else if (!strcmp("-neversmaller", input_arg)) | //from memory an intuition as far as how to set return results and so forth. |
| 872 | { | static |
| 873 | neversmaller_option_specified = 1; | int ARBLENINTS_commanate_handler(ClientData dummy, |
| 874 | } | Tcl_Interp *interp, |
| 875 | else if (!strcmp("-neverlarger", input_arg)) | int objc, |
| 876 | { | Tcl_Obj *objv[]) |
| 877 | neverlarger_option_specified = 1; | { |
| 878 | } | Tcl_Obj *rv; |
| 879 | else if (!strcmp("-n", input_arg)) | |
| 880 | { | //We must have one and exactly one additional argument |
| 881 | n_option_specified = 1; | //to this function, which is the string we want to |
| 882 | //commanate. | |
| 883 | //If -n was specified, there must be a following | if (objc != 3) |
| 884 | //parameter which supplies the integer. First | { |
| 885 | //check for existence of an additional parameter. | Tcl_WrongNumArgs(interp, |
| 886 | if (i >= (objc - 1)) | 2, |
| 887 | { | objv, |
| 888 | rv = Tcl_NewStringObj("arbint cfbrapab: -n option specified without following integer.", -1); | "sint"); |
| 889 | Tcl_SetObjResult(interp, rv); | return(TCL_ERROR); |
| 890 | } | |
| 891 | GMP_RATS_mpq_clear(&q_rn); | else |
| 892 | GMP_INTS_mpz_clear(&z_kmax); | { |
| 893 | GMP_INTS_mpz_clear(&z_hmax); | char *string_arg; |
| 894 | ||
| 895 | return(TCL_ERROR); | //Grab a pointer to the string representation of |
| 896 | } | //the input argument. The storage does not belong to us. |
| 897 | string_arg = Tcl_GetString(objv[2]); | |
| 898 | //We have at least one additional parameter. Try | assert(string_arg != NULL); |
| 899 | //to parse out the next parameter as the integer | |
| 900 | //we need for n. | //Try to parse the string as one of the error tags. |
| 901 | i++; | //If it is one of those, it isn't an error, but don't |
| 902 | //want to touch the string. | |
| 903 | input_arg = Tcl_GetString(objv[i]); | if (GMP_INTS_identify_nan_string(string_arg) >= 0) |
| 904 | assert(input_arg != NULL); | { |
| 905 | rv = Tcl_NewStringObj(string_arg, -1); | |
| 906 | GMP_INTS_mpz_parse_into_uint32(&n, &failure, input_arg); | Tcl_SetObjResult(interp, rv); |
| 907 | return(TCL_OK); | |
| 908 | //If the parse was unsuccessful, terminate. | } |
| 909 | if (failure) | //Try to parse it as a signed integer with commas already. |
| 910 | { | //If it already has commas, there is no need to add any. |
| 911 | rv = Tcl_NewStringObj("arbint cfbrapab: -n option followed by invalid integer.", -1); | else if (BSTRFUNC_is_sint_w_commas(string_arg)) |
| 912 | Tcl_SetObjResult(interp, rv); | { |
| 913 | //This is already an acceptable commanated signed integer. Send it | |
| 914 | GMP_RATS_mpq_clear(&q_rn); | //back as the return value. |
| 915 | GMP_INTS_mpz_clear(&z_kmax); | rv = Tcl_NewStringObj(string_arg, -1); |
| 916 | GMP_INTS_mpz_clear(&z_hmax); | Tcl_SetObjResult(interp, rv); |
| 917 | return(TCL_OK); | |
| 918 | return(TCL_ERROR); | } |
| 919 | } | //Try to parse the argument as a signed integer without commas. |
| 920 | //If it is one of those, commanate it and return it. | |
| 921 | //Clip the integer into a 24-bit quantity. | else if (BSTRFUNC_is_sint_wo_commas(string_arg)) |
| 922 | n &= 0x00FFFFFF; | { |
| 923 | } | size_t len; |
| 924 | else | char *buffer; |
| 925 | { | |
| 926 | //Unrecognized option. Crash out. | len = strlen(string_arg); |
| 927 | rv = Tcl_NewStringObj("arbint cfbrapab: \"", -1); | buffer = TclpAlloc(((sizeof(char) * 4 * len) / 3) + 10); |
| 928 | Tcl_AppendToObj(rv, input_arg, -1); | strcpy(buffer, string_arg); |
| 929 | Tcl_AppendToObj(rv, "\" is not a recognized option.", -1); | BSTRFUNC_commanate(buffer); |
| 930 | Tcl_SetObjResult(interp, rv); | rv = Tcl_NewStringObj(buffer, -1); |
| 931 | TclpFree(buffer); | |
| 932 | GMP_RATS_mpq_clear(&q_rn); | Tcl_SetObjResult(interp, rv); |
| 933 | GMP_INTS_mpz_clear(&z_kmax); | return(TCL_OK); |
| 934 | GMP_INTS_mpz_clear(&z_hmax); | } |
| 935 | else | |
| 936 | return(TCL_ERROR); | { |
| 937 | } | //Error case. Must give error message. |
| 938 | } | rv = Tcl_NewStringObj("arbint commanate: \"", -1); |
| 939 | Tcl_AppendToObj(rv, string_arg, -1); | |
| 940 | //Look for any mutually exclusive options. Give a catchall if any of | Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1); |
| 941 | //them specified. Because we set them all to 1, addition is the easiest | Tcl_SetObjResult(interp, rv); |
| 942 | //way to do this. | return(TCL_ERROR); |
| 943 | if ((pred_option_specified + succ_option_specified + neversmaller_option_specified | } |
| 944 | + neverlarger_option_specified + n_option_specified) > 1) | } |
| 945 | { | } |
| 946 | rv = Tcl_NewStringObj("arbint cfbrapab: -pred, -succ, -neversmaller, -neverlarger, and -n are mutually exclusive options.", -1); | |
| 947 | Tcl_SetObjResult(interp, rv); | |
| 948 | //Handles the "const" subextension. | |
| 949 | GMP_RATS_mpq_clear(&q_rn); | //08/17/01: Visual inspection OK. |
| 950 | GMP_INTS_mpz_clear(&z_kmax); | static |
| 951 | GMP_INTS_mpz_clear(&z_hmax); | int ARBLENINTS_const_handler(ClientData dummy, |
| 952 | Tcl_Interp *interp, | |
| 953 | return(TCL_ERROR); | int objc, |
| 954 | } | Tcl_Obj *objv[]) |
| 955 | { | |
| 956 | //Split into cases based on what we're doing. This is wasteful of code, | //Table of constants used. |
| 957 | //but this is a PC application, not an embedded application. In all cases | static struct |
| 958 | //create a hard error if something goes wrong. Any anomalies should trash | { |
| 959 | //a script. | char *tag; |
| 960 | if (!pred_option_specified && !succ_option_specified && !n_option_specified) | //The symbolic tag used to identify the number. |
| 961 | { | char *desc; |
| 962 | //This is the traditional best approximation case, with the possibility of | //The full description of the number. It must consist |
| 963 | //the -neverlarger or -neversmaller being specified. This is the most messy | //of a string with lines no longer than about 70 chars, |
| 964 | //of all the cases. We must gather neighbors and figure out which is closer, | //separated by newlines, and indented by 6 spaces. |
| 965 | //and if there is a tie, which has the smaller magnitude. It is fairly | char *minmant; |
| 966 | //messy. | //The minimum mantissa or minimum representation. |
| 967 | GMP_RALG_fab_neighbor_collection_struct neighbor_data; | //May not be empty or NULL. |
| 968 | GMP_RATS_mpq_struct left_neigh, right_neigh, diff_left, diff_right, closer_neighbor; | char *mantrem; |
| 969 | int dist_cmp; | //The remaining mantissa or remaining portion of |
| 970 | int mag_cmp; | //number. May be empty, but may not be NULL. |
| 971 | char *exp; | |
| 972 | //Allocate inner dynamic variables. | //The exponent portion, if any, or NULL otherwise. |
| 973 | GMP_RATS_mpq_init(&left_neigh); | int deflen; |
| 974 | GMP_RATS_mpq_init(&right_neigh); | //The default number of digits for the constant |
| 975 | GMP_RATS_mpq_init(&diff_left); | //if none is specified. |
| 976 | GMP_RATS_mpq_init(&diff_right); | int digit_count_offset; |
| 977 | GMP_RATS_mpq_init(&closer_neighbor); | //The offset to go from string length of mantissa |
| 978 | //portions to number of digits. Cheap way to adjust | |
| 979 | //Form up the neighbor data. We're only looking for up to one neighbor on each | //for - sign and decimal point. |
| 980 | //side. | } tbl[] = |
| 981 | GMP_RALG_consecutive_fab_terms( | { |
| 982 | &q_rn, | //e--the transcendental number e. |
| 983 | &z_kmax, | { |
| 984 | &z_hmax, | //tag |
| 985 | 1, | "e", |
| 986 | 1, | //desc |
| 987 | &neighbor_data | " Historically significant transcendental constant. Digits obtained\n" |
| 988 | ); | " from http://fermi.udw.ac.za/physics/e.html on 08/17/01.", |
| 989 | //minmant | |
| 990 | //If there was an error or we couldn't get any neighbors to play with, give | "2.7", |
| 991 | //an error return. As long as we have one neighbor on either side, we can definitely | //mantrem |
| 992 | //complete. | "182818284590452353602874713526624977572470936999595749669676277240766303535" |
| 993 | if (neighbor_data.error || (!neighbor_data.equality && (!neighbor_data.n_left_out || !neighbor_data.n_right_out))) | "475945713821785251664274274663919320030599218174135966290435729003342952605956" |
| 994 | { | "307381323286279434907632338298807531952510190115738341879307021540891499348841" |
| 995 | rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1); | "675092447614606680822648001684774118537423454424371075390777449920695517027618" |
| 996 | Tcl_SetObjResult(interp, rv); | "386062613313845830007520449338265602976067371132007093287091274437470472306969" |
| 997 | "772093101416928368190255151086574637721112523897844250569536967707854499699679" | |
| 998 | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); | "468644549059879316368892300987931277361782154249992295763514822082698951936680" |
| 999 | GMP_RATS_mpq_clear(&q_rn); | "331825288693984964651058209392398294887933203625094431173012381970684161403970" |
| 1000 | GMP_INTS_mpz_clear(&z_kmax); | "198376793206832823764648042953118023287825098194558153017567173613320698112509" |
| 1001 | GMP_INTS_mpz_clear(&z_hmax); | "961818815930416903515988885193458072738667385894228792284998920868058257492796" |
| 1002 | "104841984443634632449684875602336248270419786232090021609902353043699418491463" | |
| 1003 | GMP_RATS_mpq_clear(&left_neigh); | "140934317381436405462531520961836908887070167683964243781405927145635490613031" |
| 1004 | GMP_RATS_mpq_clear(&right_neigh); | "07208510383750510115747704171898610687396965521267154688957035035", |
| 1005 | GMP_RATS_mpq_clear(&diff_left); | //exp |
| 1006 | GMP_RATS_mpq_clear(&diff_right); | NULL, |
| 1007 | GMP_RATS_mpq_clear(&closer_neighbor); | //deflen |
| 1008 | 30, | |
| 1009 | return(TCL_ERROR); | //digit_count_offset |
| 1010 | } | 1 |
| 1011 | }, | |
| 1012 | if (neighbor_data.equality) | //g_metric |
| 1013 | { | { |
| 1014 | //The equality case takes precedence, always. | //tag |
| 1015 | GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.norm_rn)); | "g_si", |
| 1016 | } | //desc |
| 1017 | else | " Gravitational acceleration in SI units, meters per second**2.\n" |
| 1018 | { | " Obtained from NIST Special Publication 811 on 08/17/01.", |
| 1019 | //The boolean test somewhat above guaranteed that we have both left | //minmant |
| 1020 | //and right neighbors. We can assume this. | "9.80665", |
| 1021 | GMP_RATS_mpq_copy(&left_neigh, &(neighbor_data.lefts[0].neighbor)); | //mantrem |
| 1022 | GMP_RATS_mpq_copy(&right_neigh, &(neighbor_data.rights[0].neighbor)); | "", |
| 1023 | //exp | |
| 1024 | GMP_RATS_mpq_sub(&diff_left, &left_neigh, &(neighbor_data.norm_rn)); | NULL, |
| 1025 | GMP_RATS_mpq_sub(&diff_right, &right_neigh, &(neighbor_data.norm_rn)); | //deflen |
| 1026 | GMP_INTS_mpz_abs(&(diff_left.num)); | 30, |
| 1027 | GMP_INTS_mpz_abs(&(diff_right.num)); | //digit_count_offset |
| 1028 | dist_cmp = GMP_RATS_mpq_cmp(&diff_left, &diff_right, NULL); | 1 |
| 1029 | }, | |
| 1030 | //If we have a tie on the distance, will need to revert to magnitude of the neighbors. | //in2m |
| 1031 | GMP_INTS_mpz_abs(&(left_neigh.num)); | { |
| 1032 | GMP_INTS_mpz_abs(&(right_neigh.num)); | //tag |
| 1033 | mag_cmp = GMP_RATS_mpq_cmp(&left_neigh, &right_neigh, NULL); | "in2m", |
| 1034 | //desc | |
| 1035 | if (!neversmaller_option_specified | " Multiplicative conversion factor from inches to meters.\n" |
| 1036 | && | " Obtained from NIST Special Publication 811 on 08/17/01.", |
| 1037 | (neverlarger_option_specified || (dist_cmp < 0) || ((dist_cmp==0) && (mag_cmp < 0)))) | //minmant |
| 1038 | { | "2.54", |
| 1039 | GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.lefts[0].neighbor)); | //mantrem |
| 1040 | } | "", |
| 1041 | else | //exp |
| 1042 | { | "e-2", |
| 1043 | GMP_RATS_mpq_copy(&closer_neighbor, &(neighbor_data.rights[0].neighbor)); | //deflen |
| 1044 | } | 30, |
| 1045 | } | //digit_count_offset |
| 1046 | 1 | |
| 1047 | //Stuff our variable of choice into a string ... | }, |
| 1048 | chars_reqd = INTFUNC_max( | //mi2km |
| 1049 | GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.num)), | { |
| 1050 | GMP_INTS_mpz_size_in_base_10(&(closer_neighbor.den)) | //tag |
| 1051 | ); | "mi2km", |
| 1052 | string_result = TclpAlloc(sizeof(char) * chars_reqd); | //desc |
| 1053 | assert(string_result != NULL); | " Multiplicative conversion factor from miles to kilometers.\n" |
| 1054 | " Obtained from NIST Special Publication 811 on 08/17/01.", | |
| 1055 | GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.num)); | //minmant |
| 1056 | rv = Tcl_NewStringObj(string_result, -1); | "1.609344", |
| 1057 | Tcl_AppendToObj(rv, "/", -1); | //mantrem |
| 1058 | GMP_INTS_mpz_to_string(string_result, &(closer_neighbor.den)); | "", |
| 1059 | Tcl_AppendToObj(rv, string_result, -1); | //exp |
| 1060 | NULL, | |
| 1061 | Tcl_SetObjResult(interp, rv); | //deflen |
| 1062 | 30, | |
| 1063 | //Deallocate variables, make normal return. | //digit_count_offset |
| 1064 | TclpFree(string_result); | 1 |
| 1065 | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); | }, |
| 1066 | GMP_RATS_mpq_clear(&q_rn); | //pi--the transcendental number PI. |
| 1067 | GMP_INTS_mpz_clear(&z_kmax); | { |
| 1068 | GMP_INTS_mpz_clear(&z_hmax); | //tag |
| 1069 | "pi", | |
| 1070 | GMP_RATS_mpq_clear(&left_neigh); | //desc |
| 1071 | GMP_RATS_mpq_clear(&right_neigh); | " Transcendental constant supplying ratio of a circle's circumference\n" |
| 1072 | GMP_RATS_mpq_clear(&diff_left); | " to its diameter. Digits obtained from http://www.joyofpi.com/\n" |
| 1073 | GMP_RATS_mpq_clear(&diff_right); | " pi.htm on 08/17/01.", |
| 1074 | GMP_RATS_mpq_clear(&closer_neighbor); | //minmant |
| 1075 | "3.14", | |
| 1076 | return(TCL_OK); | //mantrem |
| 1077 | } | "15926535897932384626433832795028841971" |
| 1078 | else if (n_option_specified) | "6939937510582097494459230781640628620899" |
| 1079 | { | "8628034825342117067982148086513282306647" |
| 1080 | char sbuf[50]; | "0938446095505822317253594081284811174502" |
| 1081 | //Static buffer just to stage 32-bit integers. | "8410270193852110555964462294895493038196" |
| 1082 | "4428810975665933446128475648233786783165" | |
| 1083 | //Multiple neighbors. Must iterate through. | "2712019091456485669234603486104543266482" |
| 1084 | "1339360726024914127372458700660631558817" | |
| 1085 | GMP_RALG_fab_neighbor_collection_struct neighbor_data; | "4881520920962829254091715364367892590360" |
| 1086 | "0113305305488204665213841469519415116094" | |
| 1087 | //Form up the neighbor data. | "3305727036575959195309218611738193261179" |
| 1088 | GMP_RALG_consecutive_fab_terms( | "3105118548074462379962749567351885752724" |
| 1089 | &q_rn, | "8912279381830119491298336733624406566430" |
| 1090 | &z_kmax, | "8602139494639522473719070217986094370277" |
| 1091 | &z_hmax, | "0539217176293176752384674818467669405132" |
| 1092 | n, | "0005681271452635608277857713427577896091" |
| 1093 | n, | "7363717872146844090122495343014654958537" |
| 1094 | &neighbor_data | "1050792279689258923542019956112129021960" |
| 1095 | ); | "8640344181598136297747713099605187072113" |
| 1096 | "4999999837297804995105973173281609631859" | |
| 1097 | //If there was an error forming up the neighbor data, create a hard error. | "5024459455346908302642522308253344685035" |
| 1098 | if (neighbor_data.error) | "2619311881710100031378387528865875332083" |
| 1099 | { | "8142061717766914730359825349042875546873" |
| 1100 | rv = Tcl_NewStringObj("arbint cfbrapab: unable to form neighbors.", -1); | "1159562863882353787593751957781857780532" |
| 1101 | Tcl_SetObjResult(interp, rv); | "1712268066130019278766111959092164201989" |
| 1102 | "3809525720106548586327886593615338182796" | |
| 1103 | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); | "8230301952035301852968995773622599413891" |
| 1104 | GMP_RATS_mpq_clear(&q_rn); | "2497217752834791315155748572424541506959" |
| 1105 | GMP_INTS_mpz_clear(&z_kmax); | "5082953311686172785588907509838175463746" |
| 1106 | GMP_INTS_mpz_clear(&z_hmax); | "4939319255060400927701671139009848824012", |
| 1107 | //exp | |
| 1108 | return(TCL_ERROR); | NULL, |
| 1109 | } | //deflen |
| 1110 | 30, | |
| 1111 | //Allocate a default buffer of 10K for the ASCII representation of integers. | //digit_count_offset |
| 1112 | //In the vast majority of cases, there will be only one allocation, because it | 1 |
| 1113 | //takes a mean integer to exceed 10K. However, the logic allows it to grow. | }, |
| 1114 | string_result_n_allocd = 10000; | //sqrt5--the square root of 5. |
| 1115 | string_result = TclpAlloc(sizeof(char) * string_result_n_allocd); | { |
| 1116 | assert(string_result != NULL); | //tag |
| 1117 | "sqrt5", | |
| 1118 | //Start off with a return value of the null string. | //desc |
| 1119 | rv = Tcl_NewStringObj("", -1); | " The square root of 5. Digits obtained from\n" |
| 1120 | " http://home.earthlink.net/~maryski/sqrt51000000.txt on 08/17/01.", | |
| 1121 | //Loop through, spitting out the left neighbors. | //minmant |
| 1122 | for (i = neighbor_data.n_left_out-1; i >= 0; i--) | "2.236", |
| 1123 | { | //mantrem |
| 1124 | //The protocol here is everyone spits out one space before | "0679774997896964091736687312762354406183596115257242708972454105209256378048" |
| 1125 | //they print anything. Must skip this on first loop iteration. | "99414414408378782274969508176150773783504253267724447073863586360121533452708866" |
| 1126 | if (i != neighbor_data.n_left_out-1) | "77817319187916581127664532263985658053576135041753378500342339241406444208643253" |
| 1127 | Tcl_AppendToObj(rv, " ", -1); | "90972525926272288762995174024406816117759089094984923713907297288984820886415426" |
| 1128 | "89894099131693577019748678884425089754132956183176921499977424801530434115035957" | |
| 1129 | //The index will be the negative of the iteration variable minus one. | "66833251249881517813940800056242085524354223555610630634282023409333198293395974" |
| 1130 | sprintf(sbuf, "%d", -i - 1); | "63522712013417496142026359047378855043896870611356600457571399565955669569175645" |
| 1131 | Tcl_AppendToObj(rv, sbuf, -1); | "78221952500060539231234005009286764875529722056766253666074485853505262330678494" |
| 1132 | "63342224231763727702663240768010444331582573350589309813622634319868647194698997" | |
| 1133 | //Force the buffer to have enough space for the components of the rational | "01808189524264459620345221411922329125981963258111041704958070481204034559949435" |
| 1134 | //number. | "06855551855572512388641655010262436312571024449618789424682903404474716115455723" |
| 1135 | chars_reqd = INTFUNC_max( | "20173767659046091852957560357798439805415538077906439363972302875606299948221385" |
| 1136 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.num)), | "21773485924535151210463455550407072278724215347787529112121211843317893351910380", |
| 1137 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[i].neighbor.den)) | //exp |
| 1138 | ); | NULL, |
| 1139 | if (chars_reqd > string_result_n_allocd) | //deflen |
| 1140 | { | 30, |
| 1141 | string_result_n_allocd = chars_reqd; | //digit_count_offset |
| 1142 | string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd); | 1 |
| 1143 | assert(string_result != NULL); | }, |
| 1144 | } | }; |
| 1145 | ||
| 1146 | //Print the rational number out to the Tcl object. | Tcl_Obj *rv; |
| 1147 | Tcl_AppendToObj(rv, " ", -1); | //Value that will be returned to caller. |
| 1148 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.num)); | int i; |
| 1149 | Tcl_AppendToObj(rv, string_result, -1); | //Iteration variable. |
| 1150 | Tcl_AppendToObj(rv, "/", -1); | int tbl_idx; |
| 1151 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[i].neighbor.den)); | //Index into lookup table, of -1 if not found. |
| 1152 | Tcl_AppendToObj(rv, string_result, -1); | int ndigits; |
| 1153 | } | //The number of digits to supply. |
| 1154 | int result_code; | |
| 1155 | //Spit out the equality case if appropriate. | //Return value from Tcl library function. |
| 1156 | if (neighbor_data.equality) | |
| 1157 | { | //We must have either one or two additional arguments. |
| 1158 | if (neighbor_data.n_left_out) | if ((objc != 3) && (objc != 4)) |
| 1159 | Tcl_AppendToObj(rv, " ", -1); | { |
| 1160 | Tcl_WrongNumArgs(interp, | |
| 1161 | Tcl_AppendToObj(rv, "0", -1); | 2, |
| 1162 | objv, | |
| 1163 | //Force the buffer to have enough space for the components of the rational | "constant_tag ?ndigits?"); |
| 1164 | //number. | return(TCL_ERROR); |
| 1165 | chars_reqd = INTFUNC_max( | } |
| 1166 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.num)), | else |
| 1167 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.norm_rn.den)) | { |
| 1168 | ); | char *string_arg; |
| 1169 | if (chars_reqd > string_result_n_allocd) | |
| 1170 | { | //Grab a pointer to the string representation of |
| 1171 | string_result_n_allocd = chars_reqd; | //the input argument. The storage does not belong to us. |
| 1172 | string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd); | string_arg = Tcl_GetString(objv[2]); |
| 1173 | assert(string_result != NULL); | assert(string_arg != NULL); |
| 1174 | } | |
| 1175 | //Try to look up the string argument in the table. | |
| 1176 | //Print the rational number out to the Tcl object. | tbl_idx = -1; |
| 1177 | Tcl_AppendToObj(rv, " ", -1); | for (i=0; i<sizeof(tbl)/sizeof(tbl[0]); i++) |
| 1178 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.num)); | { |
| 1179 | Tcl_AppendToObj(rv, string_result, -1); | if (!strcmp(string_arg, tbl[i].tag)) |
| 1180 | Tcl_AppendToObj(rv, "/", -1); | { |
| 1181 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.norm_rn.den)); | tbl_idx = i; |
| 1182 | Tcl_AppendToObj(rv, string_result, -1); | break; |
| 1183 | } | } |
| 1184 | } | |
| 1185 | //Loop through, spitting out the right neighbors. | |
| 1186 | for (i = 0; i < neighbor_data.n_right_out; i++) | //If the tag was not found in the table, print a hostile |
| 1187 | { | //message and abort. |
| 1188 | //The protocol here is everyone spits out one space before | if (tbl_idx == -1) |
| 1189 | //they print anything. Must skip this on first loop iteration. | { |
| 1190 | if (neighbor_data.n_left_out || neighbor_data.equality || i) | char buf[100]; |
| 1191 | Tcl_AppendToObj(rv, " ", -1); | |
| 1192 | //Error case. Must give error message. | |
| 1193 | //The index will be the iteration variable plus one. | //Must also list the constants available. |
| 1194 | sprintf(sbuf, "%d", i+1); | rv = Tcl_NewStringObj("arbint const: \"", -1); |
| 1195 | Tcl_AppendToObj(rv, sbuf, -1); | Tcl_AppendToObj(rv, string_arg, -1); |
| 1196 | Tcl_AppendToObj(rv, "\" is not a recognized constant.\n", -1); | |
| 1197 | //Force the buffer to have enough space for the components of the rational | |
| 1198 | //number. | Tcl_AppendToObj(rv, "Available constants are:\n", -1); |
| 1199 | chars_reqd = INTFUNC_max( | |
| 1200 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.num)), | for (i=0; i<sizeof(tbl)/sizeof(tbl[0]); i++) |
| 1201 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[i].neighbor.den)) | { |
| 1202 | ); | Tcl_AppendToObj(rv, " ", -1); |
| 1203 | if (chars_reqd > string_result_n_allocd) | Tcl_AppendToObj(rv, tbl[i].tag, -1); |
| 1204 | { | sprintf(buf, " (%d digits available)\n", |
| 1205 | string_result_n_allocd = chars_reqd; | strlen(tbl[i].minmant) + strlen(tbl[i].mantrem) - tbl[i].digit_count_offset); |
| 1206 | string_result = TclpRealloc(string_result, sizeof(char) * string_result_n_allocd); | Tcl_AppendToObj(rv, buf, -1); |
| 1207 | assert(string_result != NULL); | Tcl_AppendToObj(rv, tbl[i].desc, -1); |
| 1208 | } | if (i != (sizeof(tbl)/sizeof(tbl[0]) - 1)) |
| 1209 | Tcl_AppendToObj(rv, "\n", -1); | |
| 1210 | //Print the rational number out to the Tcl object. | } |
| 1211 | Tcl_AppendToObj(rv, " ", -1); | |
| 1212 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.num)); | Tcl_SetObjResult(interp, rv); |
| 1213 | Tcl_AppendToObj(rv, string_result, -1); | return(TCL_ERROR); |
| 1214 | Tcl_AppendToObj(rv, "/", -1); | } |
| 1215 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[i].neighbor.den)); | |
| 1216 | Tcl_AppendToObj(rv, string_result, -1); | //Make assertions about the string pointers. |
| 1217 | } | assert(tbl[tbl_idx].tag != NULL); |
| 1218 | assert(tbl[tbl_idx].desc != NULL); | |
| 1219 | //Set up for a normal return. | assert(tbl[tbl_idx].minmant != NULL); |
| 1220 | Tcl_SetObjResult(interp, rv); | assert(tbl[tbl_idx].mantrem != NULL); |
| 1221 | ||
| 1222 | TclpFree(string_result); | //Assume the default number of digits by default. |
| 1223 | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); | ndigits = tbl[tbl_idx].deflen; |
| 1224 | GMP_RATS_mpq_clear(&q_rn); | |
| 1225 | GMP_INTS_mpz_clear(&z_kmax); | //If there is an additional parameter, try to interpret |
| 1226 | GMP_INTS_mpz_clear(&z_hmax); | //that as the number of digits. |
| 1227 | if (objc == 4) | |
| 1228 | return(TCL_OK); | { |
| 1229 | } | //SetIntFromAny(interp, objPtr) |
| 1230 | else if (pred_option_specified) | result_code = Tcl_GetIntFromObj(NULL, objv[3], &ndigits); |
| 1231 | { | |
| 1232 | //Simple predecessor case. | if (result_code != TCL_OK) |
| 1233 | { | |
| 1234 | GMP_RALG_fab_neighbor_collection_struct neighbor_data; | //Could not obtain an integer. Use hostile error |
| 1235 | //message and abort. | |
| 1236 | //Form up the neighbor data. | string_arg = Tcl_GetString(objv[3]); |
| 1237 | GMP_RALG_consecutive_fab_terms( | assert(string_arg != NULL); |
| 1238 | &q_rn, | |
| 1239 | &z_kmax, | rv = Tcl_NewStringObj("arbint const: \"", -1); |
| 1240 | &z_hmax, | Tcl_AppendToObj(rv, string_arg, -1); |
| 1241 | 1, | Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1); |
| 1242 | 0, | Tcl_SetObjResult(interp, rv); |
| 1243 | &neighbor_data | return(TCL_ERROR); |
| 1244 | ); | } |
| 1245 | } | |
| 1246 | //If there was an error forming up the neighbor data or there are no left neighbors, | |
| 1247 | //create a hard error. | //Ndigits may be corrupt. We have to be careful below to not |
| 1248 | if (neighbor_data.error || !neighbor_data.n_left_out) | //allow any funny stuff. |
| 1249 | { | rv = Tcl_NewStringObj(tbl[tbl_idx].minmant, -1); |
| 1250 | rv = Tcl_NewStringObj("arbint cfbrapab: unable to find predecessor.", -1); | ndigits = ndigits - strlen(tbl[tbl_idx].minmant) + tbl[tbl_idx].digit_count_offset; |
| 1251 | Tcl_SetObjResult(interp, rv); | if (ndigits > 0) |
| 1252 | { | |
| 1253 | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); | if (ndigits >= (int)strlen(tbl[tbl_idx].mantrem)) |
| 1254 | GMP_RATS_mpq_clear(&q_rn); | { |
| 1255 | GMP_INTS_mpz_clear(&z_kmax); | Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, -1); |
| 1256 | GMP_INTS_mpz_clear(&z_hmax); | } |
| 1257 | else | |
| 1258 | return(TCL_ERROR); | { |
| 1259 | } | Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, ndigits); |
| 1260 | } | |
| 1261 | //The test above confirmed that we have at least one left neighbor calculated. | } |
| 1262 | //We can dump it to a string and finish up. | |
| 1263 | chars_reqd = INTFUNC_max( | //Append the exponent portion. |
| 1264 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.num)), | if (tbl[tbl_idx].exp) |
| 1265 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.lefts[0].neighbor.den)) | Tcl_AppendToObj(rv, tbl[tbl_idx].exp, -1); |
| 1266 | ); | |
| 1267 | string_result = TclpAlloc(sizeof(char) * chars_reqd); | //Default successful return. |
| 1268 | assert(string_result != NULL); | Tcl_SetObjResult(interp, rv); |
| 1269 | return(TCL_OK); | |
| 1270 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.num)); | } |
| 1271 | rv = Tcl_NewStringObj(string_result, -1); | } |
| 1272 | Tcl_AppendToObj(rv, "/", -1); | |
| 1273 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.lefts[0].neighbor.den)); | |
| 1274 | Tcl_AppendToObj(rv, string_result, -1); | //Handles the "decommanate" subextension. |
| 1275 | //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this | |
| 1276 | Tcl_SetObjResult(interp, rv); | //from memory an intuition as far as how to set return results and so forth. |
| 1277 | static | |
| 1278 | TclpFree(string_result); | int ARBLENINTS_decommanate_handler(ClientData dummy, |
| 1279 | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); | Tcl_Interp *interp, |
| 1280 | GMP_RATS_mpq_clear(&q_rn); | int objc, |
| 1281 | GMP_INTS_mpz_clear(&z_kmax); | Tcl_Obj *objv[]) |
| 1282 | GMP_INTS_mpz_clear(&z_hmax); | { |
| 1283 | Tcl_Obj *rv; | |
| 1284 | return(TCL_OK); | |
| 1285 | } | //We must have one and exactly one additional argument |
| 1286 | else if (succ_option_specified) | //to this function, which is the string we want to |
| 1287 | { | //decommanate. |
| 1288 | //Simple successor. | if (objc != 3) |
| 1289 | { | |
| 1290 | GMP_RALG_fab_neighbor_collection_struct neighbor_data; | Tcl_WrongNumArgs(interp, |
| 1291 | 2, | |
| 1292 | //Form up the neighbor data. | objv, |
| 1293 | GMP_RALG_consecutive_fab_terms( | "sint"); |
| 1294 | &q_rn, | return(TCL_ERROR); |
| 1295 | &z_kmax, | } |
| 1296 | &z_hmax, | else |
| 1297 | 0, | { |
| 1298 | 1, | char *string_arg; |
| 1299 | &neighbor_data | |
| 1300 | ); | //Grab a pointer to the string representation of |
| 1301 | //the input argument. The storage does not belong to us. | |
| 1302 | //If there was an error forming up the neighbor data or there are no right neighbors, | string_arg = Tcl_GetString(objv[2]); |
| 1303 | //create a hard error. | assert(string_arg != NULL); |
| 1304 | if (neighbor_data.error || !neighbor_data.n_right_out) | |
| 1305 | { | //Try to parse the string as one of the error tags. |
| 1306 | rv = Tcl_NewStringObj("arbint cfbrapab: unable to find successor.", -1); | //If it is one of those, it isn't an error, but don't |
| 1307 | Tcl_SetObjResult(interp, rv); | //want to touch the string. |
| 1308 | if (GMP_INTS_identify_nan_string(string_arg) >= 0) | |
| 1309 | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); | { |
| 1310 | GMP_RATS_mpq_clear(&q_rn); | rv = Tcl_NewStringObj(string_arg, -1); |
| 1311 | GMP_INTS_mpz_clear(&z_kmax); | Tcl_SetObjResult(interp, rv); |
| 1312 | GMP_INTS_mpz_clear(&z_hmax); | return(TCL_OK); |
| 1313 | } | |
| 1314 | return(TCL_ERROR); | //Try to parse it as a signed integer without commas. |
| 1315 | } | //If it has no commas, there is no need to decommanate it. |
| 1316 | else if (BSTRFUNC_is_sint_wo_commas(string_arg)) | |
| 1317 | //The test above confirmed that we have at least one right neighbor calculated. | { |
| 1318 | //We can dump it to a string and finish up. | //This is already an acceptable commanated signed integer. Send it |
| 1319 | chars_reqd = INTFUNC_max( | //back as the return value. |
| 1320 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.num)), | rv = Tcl_NewStringObj(string_arg, -1); |
| 1321 | GMP_INTS_mpz_size_in_base_10(&(neighbor_data.rights[0].neighbor.den)) | Tcl_SetObjResult(interp, rv); |
| 1322 | ); | return(TCL_OK); |
| 1323 | string_result = TclpAlloc(sizeof(char) * chars_reqd); | } |
| 1324 | assert(string_result != NULL); | //Try to parse the argument as a signed integer with commas. |
| 1325 | //If it is one of those, decommanate it and return it. | |
| 1326 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.num)); | else if (BSTRFUNC_is_sint_w_commas(string_arg)) |
| 1327 | rv = Tcl_NewStringObj(string_result, -1); | { |
| 1328 | Tcl_AppendToObj(rv, "/", -1); | size_t len; |
| 1329 | GMP_INTS_mpz_to_string(string_result, &(neighbor_data.rights[0].neighbor.den)); | char *buffer; |
| 1330 | Tcl_AppendToObj(rv, string_result, -1); | |
| 1331 | len = strlen(string_arg); | |
| 1332 | Tcl_SetObjResult(interp, rv); | buffer = TclpAlloc(sizeof(char) * len + 1); |
| 1333 | strcpy(buffer, string_arg); | |
| 1334 | TclpFree(string_result); | BSTRFUNC_decommanate(buffer); |
| 1335 | GMP_RALG_consecutive_fab_terms_result_free(&neighbor_data); | rv = Tcl_NewStringObj(buffer, -1); |
| 1336 | GMP_RATS_mpq_clear(&q_rn); | TclpFree(buffer); |
| 1337 | GMP_INTS_mpz_clear(&z_kmax); | Tcl_SetObjResult(interp, rv); |
| 1338 | GMP_INTS_mpz_clear(&z_hmax); | return(TCL_OK); |
| 1339 | } | |
| 1340 | return(TCL_OK); | else |
| 1341 | } | { |
| 1342 | //Error case. Must give error message. | |
| 1343 | //Free up all dynamic memory. | rv = Tcl_NewStringObj("arbint decommanate: \"", -1); |
| 1344 | GMP_RATS_mpq_clear(&q_rn); | Tcl_AppendToObj(rv, string_arg, -1); |
| 1345 | GMP_INTS_mpz_clear(&z_kmax); | Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1); |
| 1346 | GMP_INTS_mpz_clear(&z_hmax); | Tcl_SetObjResult(interp, rv); |
| 1347 | return(TCL_ERROR); | |
| 1348 | //Return | } |
| 1349 | return(TCL_OK); | } |
| 1350 | } | } |
| 1351 | } | |
| 1352 | ||
| 1353 | //Handles the "intadd" subextension. | |
| 1354 | //Handles the "cfratnum" subextension. | //08/06/01: Visual inspection OK. |
| 1355 | //08/07/01: Visually inspected, OK. | static |
| 1356 | static | int ARBLENINTS_intadd_handler(ClientData dummy, |
| 1357 | int ARBLENINTS_cfratnum_handler(ClientData dummy, | Tcl_Interp *interp, |
| 1358 | Tcl_Interp *interp, | int objc, |
| 1359 | int objc, | Tcl_Obj *objv[]) |
| 1360 | Tcl_Obj *objv[]) | { |
| 1361 | { | Tcl_Obj *rv; |
| 1362 | Tcl_Obj *rv; | |
| 1363 | //We must have two and exactly two additional arguments | |
| 1364 | //We must have exactly one additional argument | //to this function, which are the integers whose |
| 1365 | //to this function, which is the rational number | //sum is to be calculated. |
| 1366 | //whose continued fraction decomposition is to be | if (objc != 4) |
| 1367 | //calculated. | { |
| 1368 | if (objc != 3) | Tcl_WrongNumArgs(interp, |
| 1369 | { | 2, |
| 1370 | Tcl_WrongNumArgs(interp, | objv, |
| 1371 | 2, | "sint sint"); |
| 1372 | objv, | return(TCL_ERROR); |
| 1373 | "urn"); | } |
| 1374 | return(TCL_ERROR); | else |
| 1375 | } | { |
| 1376 | else | GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result; |
| 1377 | { | char *add_arg1, *add_arg2; |
| 1378 | char *input_arg; | int failure1, failure2; |
| 1379 | int failure; | unsigned chars_reqd; |
| 1380 | unsigned chars_reqd; | char *string_result; |
| 1381 | char *string_result; | int i, j; |
| 1382 | int n_string_result; | |
| 1383 | int i; | //Allocate space for the arbitrary-length integer result. |
| 1384 | GMP_RATS_mpq_struct rn; | GMP_INTS_mpz_init(&arb_arg1); |
| 1385 | GMP_RALG_cf_app_struct decomp; | GMP_INTS_mpz_init(&arb_arg2); |
| 1386 | GMP_INTS_mpz_init(&arb_result); | |
| 1387 | //In this function, we are going to return a string | |
| 1388 | //result formed by starting with a string and then | //Grab pointers to the string representation of |
| 1389 | //concatenating to it again and again. We start | //the input arguments. The storage does not belong to us. |
| 1390 | //off believing that 10,000 characters of space is enough, | add_arg1 = Tcl_GetString(objv[2]); |
| 1391 | //but we may need to revise upward and reallocate. | assert(add_arg1 != NULL); |
| 1392 | //A 10,000 character block is chosen because it is quick | add_arg2 = Tcl_GetString(objv[3]); |
| 1393 | //to allocate and most times won't go beyond that. | assert(add_arg2 != NULL); |
| 1394 | n_string_result = 10000; | |
| 1395 | string_result = TclpAlloc(sizeof(char) * n_string_result); | //Try to interpret either of the strings as one of the NAN tags. |
| 1396 | assert(string_result != NULL); | //If it is one, return the appropriate result for |
| 1397 | //a binary operation. | |
| 1398 | //We will need a rational number to hold the return value | i = GMP_INTS_identify_nan_string(add_arg1); |
| 1399 | //from the parsing function. Allocate that now. | j = GMP_INTS_identify_nan_string(add_arg2); |
| 1400 | GMP_RATS_mpq_init(&rn); | |
| 1401 | if ((i >= 0) || (j >= 0)) | |
| 1402 | //Grab a pointer to the string representation of | { |
| 1403 | //the input argument. The storage does not belong to us. | const char *p; |
| 1404 | input_arg = Tcl_GetString(objv[2]); | |
| 1405 | assert(input_arg != NULL); | //Find the max of i and j. This isn't a scientific way to tag the |
| 1406 | //result, but will be OK. Some information is lost no matter what | |
| 1407 | //Try to parse our input string as a rational number. | //we do. |
| 1408 | //If we are not successful in this, must abort. | if (i > j) |
| 1409 | GMP_RATS_mpq_set_all_format_rat_num(input_arg, | ; |
| 1410 | &failure, | else |
| 1411 | &rn); | i = j; |
| 1412 | ||
| 1413 | if (failure) | //i now contains the max. |
| 1414 | { | switch (i) |
| 1415 | rv = Tcl_NewStringObj("arbint cfratnum: \"", -1); | { |
| 1416 | Tcl_AppendToObj(rv, input_arg, -1); | case 0: p = GMP_INTS_supply_nan_string(2); |
| 1417 | break; | |
| 1418 | Tcl_AppendToObj(rv, "\" is not a recognized non-negative rational number.", -1); | case 1: p = GMP_INTS_supply_nan_string(3); |
| 1419 | Tcl_SetObjResult(interp, rv); | break; |
| 1420 | case 2: p = GMP_INTS_supply_nan_string(2); | |
| 1421 | TclpFree(string_result); | break; |
| 1422 | GMP_RATS_mpq_clear(&rn); | case 3: p = GMP_INTS_supply_nan_string(3); |
| 1423 | break; | |
| 1424 | return(TCL_ERROR); | default: |
| 1425 | } | assert(0); |
| 1426 | break; | |
| 1427 | //OK, we have a rational number, but there is a possibility | } |
| 1428 | //it is negative, which is a no-no. Normalize the signs | |
| 1429 | //for easier testing. | rv = Tcl_NewStringObj(p, -1); |
| 1430 | GMP_RATS_mpq_normalize_sign(&rn); | Tcl_SetObjResult(interp, rv); |
| 1431 | if (GMP_INTS_mpz_is_neg(&(rn.num))) | |
| 1432 | { | GMP_INTS_mpz_clear(&arb_arg1); |
| 1433 | rv = Tcl_NewStringObj("arbint cfratnum: \"", -1); | GMP_INTS_mpz_clear(&arb_arg2); |
| 1434 | Tcl_AppendToObj(rv, input_arg, -1); | GMP_INTS_mpz_clear(&arb_result); |
| 1435 | ||
| 1436 | Tcl_AppendToObj(rv, "\" is negative.", -1); | return(TCL_OK); |
| 1437 | Tcl_SetObjResult(interp, rv); | } |
| 1438 | ||
| 1439 | TclpFree(string_result); | //Try to convert both strings into arbitrary integers. |
| 1440 | GMP_RATS_mpq_clear(&rn); | GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, add_arg1); |
| 1441 | GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, add_arg2); | |
| 1442 | return(TCL_ERROR); | |
| 1443 | } | //If there was a parse failure, we have to return an error |
| 1444 | //message. It is possible that both arguments failed the parse, | |
| 1445 | //OK, we have a rational number. Form the continued fraction | //but only return one in the error message. |
| 1446 | //decomposition of it. The function called is set up so that | if (failure1 || failure2) |
| 1447 | //one must deallocate, even in an error condition. | { |
| 1448 | GMP_RALG_cfdecomp_init(&decomp, | rv = Tcl_NewStringObj("arbint intadd: \"", -1); |
| 1449 | &failure, | if (failure1) |
| 1450 | &(rn.num), | Tcl_AppendToObj(rv, add_arg1, -1); |
| 1451 | &(rn.den)); | else |
| 1452 | Tcl_AppendToObj(rv, add_arg2, -1); | |
| 1453 | //If we failed in the decomposition (don't know why that would | |
| 1454 | //happen) use the general error flag "NAN". | Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1); |
| 1455 | if (failure) | Tcl_SetObjResult(interp, rv); |
| 1456 | { | |
| 1457 | rv = Tcl_NewStringObj("NAN", -1); | GMP_INTS_mpz_clear(&arb_arg1); |
| 1458 | GMP_INTS_mpz_clear(&arb_arg2); | |
| 1459 | Tcl_SetObjResult(interp, rv); | GMP_INTS_mpz_clear(&arb_result); |
| 1460 | ||
| 1461 | TclpFree(string_result); | return(TCL_ERROR); |
| 1462 | GMP_RATS_mpq_clear(&rn); | } |
| 1463 | GMP_RALG_cfdecomp_destroy(&decomp); | |
| 1464 | //Calculate the sum. | |
| 1465 | return(TCL_ERROR); | GMP_INTS_mpz_add(&arb_result, &arb_arg1, &arb_arg2); |
| 1466 | } | |
| 1467 | //Figure out the number of characters required for | |
| 1468 | //OK, that really is the last error we could have. | //the output string. |
| 1469 | //Iterate, adding the partial quotients and convergents | chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result); |
| 1470 | //to the string which we'll return. We need to watch out | |
| 1471 | //for running over our 10K buffer. | //Allocate space for the conversion result. |
| 1472 | rv = Tcl_NewStringObj("", -1); | string_result = TclpAlloc(sizeof(char) * chars_reqd); |
| 1473 | for (i=0; i<decomp.n; i++) | assert(string_result != NULL); |
| 1474 | { | |
| 1475 | //Partial quotient. | //Make the conversion to a character string. |
| 1476 | chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.a[i])); | GMP_INTS_mpz_to_string(string_result, &arb_result); |
| 1477 | if (chars_reqd > (unsigned)n_string_result) | |
| 1478 | { | //Assign the string result to a Tcl object. |
| 1479 | n_string_result = chars_reqd; | rv = Tcl_NewStringObj(string_result, -1); |
| 1480 | string_result = TclpRealloc(string_result, | |
| 1481 | sizeof(char) * n_string_result); | //Deallocate the string. |
| 1482 | } | TclpFree(string_result); |
| 1483 | GMP_INTS_mpz_to_string(string_result, &(decomp.a[i])); | |
| 1484 | Tcl_AppendToObj(rv, string_result, -1); | //Deallocate space for the arbitrary-length integers. |
| 1485 | Tcl_AppendToObj(rv, " ", -1); | GMP_INTS_mpz_clear(&arb_arg1); |
| 1486 | GMP_INTS_mpz_clear(&arb_arg2); | |
| 1487 | //Numerator of convergent. | GMP_INTS_mpz_clear(&arb_result); |
| 1488 | chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.p[i])); | |
| 1489 | if (chars_reqd > (unsigned)n_string_result) | //Assign the result to be the return value. |
| 1490 | { | Tcl_SetObjResult(interp, rv); |
| 1491 | n_string_result = chars_reqd; | |
| 1492 | string_result = TclpRealloc(string_result, | //Return |
| 1493 | sizeof(char) * n_string_result); | return(TCL_OK); |
| 1494 | } | } |
| 1495 | GMP_INTS_mpz_to_string(string_result, &(decomp.p[i])); | } |
| 1496 | Tcl_AppendToObj(rv, string_result, -1); | |
| 1497 | Tcl_AppendToObj(rv, " ", -1); | |
| 1498 | //08/01/01: Visual inspection and some unit testing, OK. | |
| 1499 | //Denominator of convergent. | //Handles the "intcmp" subextension. |
| 1500 | chars_reqd = GMP_INTS_mpz_size_in_base_10(&(decomp.q[i])); | static |
| 1501 | if (chars_reqd > (unsigned)n_string_result) | int ARBLENINTS_intcmp_handler(ClientData dummy, |
| 1502 | { | Tcl_Interp *interp, |
| 1503 | n_string_result = chars_reqd; | int objc, |
| 1504 | string_result = TclpRealloc(string_result, | Tcl_Obj *objv[]) |
| 1505 | sizeof(char) * n_string_result); | { |
| 1506 | } | Tcl_Obj *rv; |
| 1507 | GMP_INTS_mpz_to_string(string_result, &(decomp.q[i])); | |
| 1508 | Tcl_AppendToObj(rv, string_result, -1); | //We must have two and exactly two additional arguments |
| 1509 | if (i != (decomp.n - 1)) //No space after last number. | //to this function, which are the integers to be compared. |
| 1510 | Tcl_AppendToObj(rv, " ", -1); | if (objc != 4) |
| 1511 | } | { |
| 1512 | Tcl_WrongNumArgs(interp, | |
| 1513 | //Assign the result to be the return value. | 2, |
| 1514 | Tcl_SetObjResult(interp, rv); | objv, |
| 1515 | "sint sint"); | |
| 1516 | //Free up all dynamic memory. | return(TCL_ERROR); |
| 1517 | TclpFree(string_result); | } |
| 1518 | GMP_RATS_mpq_clear(&rn); | else |
| 1519 | GMP_RALG_cfdecomp_destroy(&decomp); | { |
| 1520 | GMP_INTS_mpz_struct arb_arg1, arb_arg2; | |
| 1521 | //Return | char *cmp_arg1, *cmp_arg2; |
| 1522 | return(TCL_OK); | int failure1, failure2; |
| 1523 | } | int i, j, compare_result; |
| 1524 | } | |
| 1525 | //Allocate space for the arbitrary-length integer result. | |
| 1526 | GMP_INTS_mpz_init(&arb_arg1); | |
| 1527 | //Handles the "commanate" subextension. | GMP_INTS_mpz_init(&arb_arg2); |
| 1528 | //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this | |
| 1529 | //from memory an intuition as far as how to set return results and so forth. | //Grab pointers to the string representation of |
| 1530 | static | //the input arguments. The storage does not belong to us. |
| 1531 | int ARBLENINTS_commanate_handler(ClientData dummy, | cmp_arg1 = Tcl_GetString(objv[2]); |
| 1532 | Tcl_Interp *interp, | assert(cmp_arg1 != NULL); |
| 1533 | int objc, | cmp_arg2 = Tcl_GetString(objv[3]); |
| 1534 | Tcl_Obj *objv[]) | assert(cmp_arg2 != NULL); |
| 1535 | { | |
| 1536 | Tcl_Obj *rv; | //Try to interpret either of the strings as one of the NAN tags. |
| 1537 | //We cannot compare NAN tags. If either is a NAN tag, we must signal an | |
| 1538 | //We must have one and exactly one additional argument | //error. |
| 1539 | //to this function, which is the string we want to | i = GMP_INTS_identify_nan_string(cmp_arg1); |
| 1540 | //commanate. | j = GMP_INTS_identify_nan_string(cmp_arg2); |
| 1541 | if (objc != 3) | |
| 1542 | { | if ((i >= 0) || (j >= 0)) |
| 1543 | Tcl_WrongNumArgs(interp, | { |
| 1544 | 2, | rv = Tcl_NewStringObj("arbint intcmp: cannot compare NAN symbolic tags.", -1); |
| 1545 | objv, | Tcl_SetObjResult(interp, rv); |
| 1546 | "sint"); | |
| 1547 | return(TCL_ERROR); | GMP_INTS_mpz_clear(&arb_arg1); |
| 1548 | } | GMP_INTS_mpz_clear(&arb_arg2); |
| 1549 | else | |
| 1550 | { | return(TCL_ERROR); |
| 1551 | char *string_arg; | } |
| 1552 | ||
| 1553 | //Grab a pointer to the string representation of | //Try to convert both strings into arbitrary integers. |
| 1554 | //the input argument. The storage does not belong to us. | GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, cmp_arg1); |
| 1555 | string_arg = Tcl_GetString(objv[2]); | GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, cmp_arg2); |
| 1556 | assert(string_arg != NULL); | |
| 1557 | //If there was a parse failure, we have to return an error | |
| 1558 | //Try to parse the string as one of the error tags. | //message. It is possible that both arguments failed the parse, |
| 1559 | //If it is one of those, it isn't an error, but don't | //but only return one in the error message. |
| 1560 | //want to touch the string. | if (failure1 || failure2) |
| 1561 | if (GMP_INTS_identify_nan_string(string_arg) >= 0) | { |
| 1562 | { | rv = Tcl_NewStringObj("arbint intcmp: \"", -1); |
| 1563 | rv = Tcl_NewStringObj(string_arg, -1); | if (failure1) |
| 1564 | Tcl_SetObjResult(interp, rv); | Tcl_AppendToObj(rv, cmp_arg1, -1); |
| 1565 | return(TCL_OK); | else |
| 1566 | } | Tcl_AppendToObj(rv, cmp_arg2, -1); |
| 1567 | //Try to parse it as a signed integer with commas already. | |
| 1568 | //If it already has commas, there is no need to add any. | Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1); |
| 1569 | else if (BSTRFUNC_is_sint_w_commas(string_arg)) | Tcl_SetObjResult(interp, rv); |
| 1570 | { | |
| 1571 | //This is already an acceptable commanated signed integer. Send it | GMP_INTS_mpz_clear(&arb_arg1); |
| 1572 | //back as the return value. | GMP_INTS_mpz_clear(&arb_arg2); |
| 1573 | rv = Tcl_NewStringObj(string_arg, -1); | |
| 1574 | Tcl_SetObjResult(interp, rv); | return(TCL_ERROR); |
| 1575 | return(TCL_OK); | } |
| 1576 | } | |
| 1577 | //Try to parse the argument as a signed integer without commas. | //Calculate the compare result. |
| 1578 | //If it is one of those, commanate it and return it. | compare_result = GMP_INTS_mpz_cmp(&arb_arg1, &arb_arg2); |
| 1579 | else if (BSTRFUNC_is_sint_wo_commas(string_arg)) | |
| 1580 | { | //Assign the return value based on the result. |
| 1581 | size_t len; | if (compare_result < 0) |
| 1582 | char *buffer; | rv = Tcl_NewStringObj("-1", -1); |
| 1583 | else if (compare_result == 0) | |
| 1584 | len = strlen(string_arg); | rv = Tcl_NewStringObj("0", -1); |
| 1585 | buffer = TclpAlloc(((sizeof(char) * 4 * len) / 3) + 10); | else |
| 1586 | strcpy(buffer, string_arg); | rv = Tcl_NewStringObj("1", -1); |
| 1587 | BSTRFUNC_commanate(buffer); | |
| 1588 | rv = Tcl_NewStringObj(buffer, -1); | //Deallocate space for the arbitrary-length integers. |
| 1589 | TclpFree(buffer); | GMP_INTS_mpz_clear(&arb_arg1); |
| 1590 | Tcl_SetObjResult(interp, rv); | GMP_INTS_mpz_clear(&arb_arg2); |
| 1591 | return(TCL_OK); | |
| 1592 | } | //Assign the result to be the return value. |
| 1593 | else | Tcl_SetObjResult(interp, rv); |
| 1594 | { | |
| 1595 | //Error case. Must give error message. | //Return |
| 1596 | rv = Tcl_NewStringObj("arbint commanate: \"", -1); | return(TCL_OK); |
| 1597 | Tcl_AppendToObj(rv, string_arg, -1); | } |
| 1598 | Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1); | } |
| 1599 | Tcl_SetObjResult(interp, rv); | |
| 1600 | return(TCL_ERROR); | |
| 1601 | } | //Handles the "intdiv" subextension. |
| 1602 | } | //07/31/01: Visually inspected, OK. |
| 1603 | } | static |
| 1604 | int ARBLENINTS_intdiv_handler(ClientData dummy, | |
| 1605 | Tcl_Interp *interp, | |
| 1606 | //Handles the "const" subextension. | int objc, |
| 1607 | //08/17/01: Visual inspection OK. | Tcl_Obj *objv[]) |
| 1608 | static | { |
| 1609 | int ARBLENINTS_const_handler(ClientData dummy, | Tcl_Obj *rv; |
| 1610 | Tcl_Interp *interp, | |
| 1611 | int objc, | //We must have two and exactly two additional arguments |
| 1612 | Tcl_Obj *objv[]) | //to this function, which are the integers whose |
| 1613 | { | //integer quotient is to be calculated. |
| 1614 | //Table of constants used. | if (objc != 4) |
| 1615 | static struct | { |
| 1616 | { | Tcl_WrongNumArgs(interp, |
| 1617 | char *tag; | 2, |
| 1618 | //The symbolic tag used to identify the number. | objv, |
| 1619 | char *desc; | "sint sint"); |
| 1620 | //The full description of the number. It must consist | return(TCL_ERROR); |
| 1621 | //of a string with lines no longer than about 70 chars, | } |
| 1622 | //separated by newlines, and indented by 6 spaces. | else |
| 1623 | char *minmant; | { |
| 1624 | //The minimum mantissa or minimum representation. | GMP_INTS_mpz_struct arb_dividend, arb_divisor, arb_quotient, arb_remainder; |
| 1625 | //May not be empty or NULL. | char *dividend_arg1, *divisor_arg2; |
| 1626 | char *mantrem; | int failure1, failure2; |
| 1627 | //The remaining mantissa or remaining portion of | unsigned chars_reqd; |
| 1628 | //number. May be empty, but may not be NULL. | char *string_result; |
| 1629 | char *exp; | int i, j; |
| 1630 | //The exponent portion, if any, or NULL otherwise. | |
| 1631 | int deflen; | //Allocate space for the arbitrary-length integer arguments and results. |
| 1632 | //The default number of digits for the constant | GMP_INTS_mpz_init(&arb_dividend); |
| 1633 | //if none is specified. | GMP_INTS_mpz_init(&arb_divisor); |
| 1634 | int digit_count_offset; | GMP_INTS_mpz_init(&arb_quotient); |
| 1635 | //The offset to go from string length of mantissa | GMP_INTS_mpz_init(&arb_remainder); |
| 1636 | //portions to number of digits. Cheap way to adjust | |
| 1637 | //for - sign and decimal point. | //Grab pointers to the string representation of |
| 1638 | } tbl[] = | //the input arguments. The storage does not belong to us. |
| 1639 | { | dividend_arg1 = Tcl_GetString(objv[2]); |
| 1640 | //e--the transcendental number e. | assert(dividend_arg1 != NULL); |
| 1641 | { | divisor_arg2 = Tcl_GetString(objv[3]); |
| 1642 | //tag | assert(divisor_arg2 != NULL); |
| 1643 | "e", | |
| 1644 | //desc | //Try to interpret either of the strings as one of the NAN tags. |
| 1645 | " Historically significant transcendental constant. Digits obtained\n" | //If it is one, return the appropriate result for |
| 1646 | " from http://fermi.udw.ac.za/physics/e.html on 08/17/01.", | //a binary operation. |
| 1647 | //minmant | i = GMP_INTS_identify_nan_string(dividend_arg1); |
| 1648 | "2.7", | j = GMP_INTS_identify_nan_string(divisor_arg2); |
| 1649 | //mantrem | |
| 1650 | "182818284590452353602874713526624977572470936999595749669676277240766303535" | if ((i >= 0) || (j >= 0)) |
| 1651 | "475945713821785251664274274663919320030599218174135966290435729003342952605956" | { |
| 1652 | "307381323286279434907632338298807531952510190115738341879307021540891499348841" | const char *p; |
| 1653 | "675092447614606680822648001684774118537423454424371075390777449920695517027618" | |
| 1654 | "386062613313845830007520449338265602976067371132007093287091274437470472306969" | //Find the max of i and j. This isn't a scientific way to tag the |
| 1655 | "772093101416928368190255151086574637721112523897844250569536967707854499699679" | //result, but will be OK. Some information is lost no matter what |
| 1656 | "468644549059879316368892300987931277361782154249992295763514822082698951936680" | //we do. |
| 1657 | "331825288693984964651058209392398294887933203625094431173012381970684161403970" | if (i > j) |
| 1658 | "198376793206832823764648042953118023287825098194558153017567173613320698112509" | ; |
| 1659 | "961818815930416903515988885193458072738667385894228792284998920868058257492796" | else |
| 1660 | "104841984443634632449684875602336248270419786232090021609902353043699418491463" | i = j; |
| 1661 | "140934317381436405462531520961836908887070167683964243781405927145635490613031" | |
| 1662 | "07208510383750510115747704171898610687396965521267154688957035035", | //i now contains the max. |
| 1663 | //exp | switch (i) |
| 1664 | NULL, | { |
| 1665 | //deflen | case 0: p = GMP_INTS_supply_nan_string(2); |
| 1666 | 30, | break; |
| 1667 | //digit_count_offset | case 1: p = GMP_INTS_supply_nan_string(3); |
| 1668 | 1 | break; |
| 1669 | }, | case 2: p = GMP_INTS_supply_nan_string(2); |
| 1670 | //g_metric | break; |
| 1671 | { | case 3: p = GMP_INTS_supply_nan_string(3); |
| 1672 | //tag | break; |
| 1673 | "g_si", | default: |
| 1674 | //desc | assert(0); |
| 1675 | " Gravitational acceleration in SI units, meters per second**2.\n" | break; |
| 1676 | " Obtained from NIST Special Publication 811 on 08/17/01.", | } |
| 1677 | //minmant | |
| 1678 | "9.80665", | rv = Tcl_NewStringObj(p, -1); |
| 1679 | //mantrem | Tcl_SetObjResult(interp, rv); |
| 1680 | "", | |
| 1681 | //exp | GMP_INTS_mpz_clear(&arb_dividend); |
| 1682 | NULL, | GMP_INTS_mpz_clear(&arb_divisor); |
| 1683 | //deflen | GMP_INTS_mpz_clear(&arb_quotient); |
| 1684 | 30, | GMP_INTS_mpz_clear(&arb_remainder); |
| 1685 | //digit_count_offset | |
| 1686 | 1 | return(TCL_OK); |
| 1687 | }, | } |
| 1688 | //in2m | |
| 1689 | { | //Try to convert both strings into arbitrary integers. |
| 1690 | //tag | GMP_INTS_mpz_set_general_int(&arb_dividend, &failure1, dividend_arg1); |
| 1691 | "in2m", | GMP_INTS_mpz_set_general_int(&arb_divisor, &failure2, divisor_arg2); |
| 1692 | //desc | |
| 1693 | " Multiplicative conversion factor from inches to meters.\n" | //If there was a parse failure, we have to return an error |
| 1694 | " Obtained from NIST Special Publication 811 on 08/17/01.", | //message. It is possible that both arguments failed the parse, |
| 1695 | //minmant | //but only return one in the error message. |
| 1696 | "2.54", | if (failure1 || failure2) |
| 1697 | //mantrem | { |
| 1698 | "", | rv = Tcl_NewStringObj("arbint intdiv: \"", -1); |
| 1699 | //exp | if (failure1) |
| 1700 | "e-2", | Tcl_AppendToObj(rv, dividend_arg1, -1); |
| 1701 | //deflen | else |
| 1702 | 30, | Tcl_AppendToObj(rv, divisor_arg2, -1); |
| 1703 | //digit_count_offset | |
| 1704 | 1 | Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1); |
| 1705 | }, | Tcl_SetObjResult(interp, rv); |
| 1706 | //mi2km | |
| 1707 | { | GMP_INTS_mpz_clear(&arb_dividend); |
| 1708 | //tag | GMP_INTS_mpz_clear(&arb_divisor); |
| 1709 | "mi2km", | GMP_INTS_mpz_clear(&arb_quotient); |
| 1710 | //desc | GMP_INTS_mpz_clear(&arb_remainder); |
| 1711 | " Multiplicative conversion factor from miles to kilometers.\n" | |
| 1712 | " Obtained from NIST Special Publication 811 on 08/17/01.", | return(TCL_ERROR); |
| 1713 | //minmant | } |
| 1714 | "1.609344", | |
| 1715 | //mantrem | //Calculate the quotient. |
| 1716 | "", | GMP_INTS_mpz_tdiv_qr(&arb_quotient, &arb_remainder, &arb_dividend, &arb_divisor); |
| 1717 | //exp | |
| 1718 | NULL, | //Figure out the number of characters required for |
| 1719 | //deflen | //the output string. |
| 1720 | 30, | chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_quotient); |
| 1721 | //digit_count_offset | |
| 1722 | 1 | //Allocate space for the conversion result. |
| 1723 | }, | string_result = TclpAlloc(sizeof(char) * chars_reqd); |
| 1724 | //pi--the transcendental number PI. | assert(string_result != NULL); |
| 1725 | { | |
| 1726 | //tag | //Make the conversion to a character string. |
| 1727 | "pi", | GMP_INTS_mpz_to_string(string_result, &arb_quotient); |
| 1728 | //desc | |
| 1729 | " Transcendental constant supplying ratio of a circle's circumference\n" | //Assign the string result to a Tcl object. |
| 1730 | " to its diameter. Digits obtained from http://www.joyofpi.com/\n" | rv = Tcl_NewStringObj(string_result, -1); |
| 1731 | " pi.htm on 08/17/01.", | |
| 1732 | //minmant | //Deallocate the string. |
| 1733 | "3.14", | TclpFree(string_result); |
| 1734 | //mantrem | |
| 1735 | "15926535897932384626433832795028841971" | //Deallocate space for the arbitrary-length integers. |
| 1736 | "6939937510582097494459230781640628620899" | GMP_INTS_mpz_clear(&arb_dividend); |
| 1737 | "8628034825342117067982148086513282306647" | GMP_INTS_mpz_clear(&arb_divisor); |
| 1738 | "0938446095505822317253594081284811174502" | GMP_INTS_mpz_clear(&arb_quotient); |
| 1739 | "8410270193852110555964462294895493038196" | GMP_INTS_mpz_clear(&arb_remainder); |
| 1740 | "4428810975665933446128475648233786783165" | |
| 1741 | "2712019091456485669234603486104543266482" | //Assign the result to be the return value. |
| 1742 | "1339360726024914127372458700660631558817" | Tcl_SetObjResult(interp, rv); |
| 1743 | "4881520920962829254091715364367892590360" | |
| 1744 | "0113305305488204665213841469519415116094" | //Return |
| 1745 | "3305727036575959195309218611738193261179" | return(TCL_OK); |
| 1746 | "3105118548074462379962749567351885752724" | } |
| 1747 | "8912279381830119491298336733624406566430" | } |
| 1748 | "8602139494639522473719070217986094370277" | |
| 1749 | "0539217176293176752384674818467669405132" | |
| 1750 | "0005681271452635608277857713427577896091" | //08/01/01: Visually inspected. |
| 1751 | "7363717872146844090122495343014654958537" | //Handles the "intexp" subextension. |
| 1752 | "1050792279689258923542019956112129021960" | static |
| 1753 | "8640344181598136297747713099605187072113" | int ARBLENINTS_intexp_handler(ClientData dummy, |
| 1754 | "4999999837297804995105973173281609631859" | Tcl_Interp *interp, |
| 1755 | "5024459455346908302642522308253344685035" | int objc, |
| 1756 | "2619311881710100031378387528865875332083" | Tcl_Obj *objv[]) |
| 1757 | "8142061717766914730359825349042875546873" | { |
| 1758 | "1159562863882353787593751957781857780532" | Tcl_Obj *rv; |
| 1759 | "1712268066130019278766111959092164201989" | |
| 1760 | "3809525720106548586327886593615338182796" | //We must have two and exactly two additional arguments |
| 1761 | "8230301952035301852968995773622599413891" | //to this function, which are the integers used to |
| 1762 | "2497217752834791315155748572424541506959" | //calculate the exponential. |
| 1763 | "5082953311686172785588907509838175463746" | if (objc != 4) |
| 1764 | "4939319255060400927701671139009848824012", | { |
| 1765 | //exp | Tcl_WrongNumArgs(interp, |
| 1766 | NULL, | 2, |
| 1767 | //deflen | objv, |
| 1768 | 30, | "sint uint32"); |
| 1769 | //digit_count_offset | return(TCL_ERROR); |
| 1770 | 1 | } |
| 1771 | }, | else |
| 1772 | //sqrt5--the square root of 5. | { |
| 1773 | { | GMP_INTS_mpz_struct arb_arg1, arb_result; |
| 1774 | //tag | unsigned arg2; |
| 1775 | "sqrt5", | char *str_arg1, *str_arg2; |
| 1776 | //desc | int failure1, failure2; |
| 1777 | " The square root of 5. Digits obtained from\n" | unsigned chars_reqd; |
| 1778 | " http://home.earthlink.net/~maryski/sqrt51000000.txt on 08/17/01.", | char *string_result; |
| 1779 | //minmant | int i, j; |
| 1780 | "2.236", | |
| 1781 | //mantrem | //Allocate space for the arbitrary-length integers. |
| 1782 | "0679774997896964091736687312762354406183596115257242708972454105209256378048" | GMP_INTS_mpz_init(&arb_arg1); |
| 1783 | "99414414408378782274969508176150773783504253267724447073863586360121533452708866" | GMP_INTS_mpz_init(&arb_result); |
| 1784 | "77817319187916581127664532263985658053576135041753378500342339241406444208643253" | |
| 1785 | "90972525926272288762995174024406816117759089094984923713907297288984820886415426" | //Grab pointers to the string representation of |
| 1786 | "89894099131693577019748678884425089754132956183176921499977424801530434115035957" | //the input arguments. The storage does not belong to us. |
| 1787 | "66833251249881517813940800056242085524354223555610630634282023409333198293395974" | str_arg1 = Tcl_GetString(objv[2]); |
| 1788 | "63522712013417496142026359047378855043896870611356600457571399565955669569175645" | assert(str_arg1 != NULL); |
| 1789 | "78221952500060539231234005009286764875529722056766253666074485853505262330678494" | str_arg2 = Tcl_GetString(objv[3]); |
| 1790 | "63342224231763727702663240768010444331582573350589309813622634319868647194698997" | assert(str_arg2 != NULL); |
| 1791 | "01808189524264459620345221411922329125981963258111041704958070481204034559949435" | |
| 1792 | "06855551855572512388641655010262436312571024449618789424682903404474716115455723" | //Try to interpret either of the strings as one of the NAN tags. |
| 1793 | "20173767659046091852957560357798439805415538077906439363972302875606299948221385" | //If it is one, return the appropriate result for |
| 1794 | "21773485924535151210463455550407072278724215347787529112121211843317893351910380", | //a binary operation. |
| 1795 | //exp | i = GMP_INTS_identify_nan_string(str_arg1); |
| 1796 | NULL, | j = GMP_INTS_identify_nan_string(str_arg2); |
| 1797 | //deflen | |
| 1798 | 30, | if ((i >= 0) || (j >= 0)) |
| 1799 | //digit_count_offset | { |
| 1800 | 1 | const char *p; |
| 1801 | }, | |
| 1802 | }; | //Find the max of i and j. This isn't a scientific way to tag the |
| 1803 | //result, but will be OK. Some information is lost no matter what | |
| 1804 | Tcl_Obj *rv; | //we do. |
| 1805 | //Value that will be returned to caller. | if (i > j) |
| 1806 | int i; | ; |
| 1807 | //Iteration variable. | else |
| 1808 | int tbl_idx; | i = j; |
| 1809 | //Index into lookup table, of -1 if not found. | |
| 1810 | int ndigits; | //i now contains the max. |
| 1811 | //The number of digits to supply. | switch (i) |
| 1812 | int result_code; | { |
| 1813 | //Return value from Tcl library function. | case 0: p = GMP_INTS_supply_nan_string(2); |
| 1814 | break; | |
| 1815 | //We must have either one or two additional arguments. | case 1: p = GMP_INTS_supply_nan_string(3); |
| 1816 | if ((objc != 3) && (objc != 4)) | break; |
| 1817 | { | case 2: p = GMP_INTS_supply_nan_string(2); |
| 1818 | Tcl_WrongNumArgs(interp, | break; |
| 1819 | 2, | case 3: p = GMP_INTS_supply_nan_string(3); |
| 1820 | objv, | break; |
| 1821 | "constant_tag ?ndigits?"); | default: |
| 1822 | return(TCL_ERROR); | assert(0); |
| 1823 | } | break; |
| 1824 | else | } |
| 1825 | { | |
| 1826 | char *string_arg; | rv = Tcl_NewStringObj(p, -1); |
| 1827 | Tcl_SetObjResult(interp, rv); | |
| 1828 | //Grab a pointer to the string representation of | |
| 1829 | //the input argument. The storage does not belong to us. | GMP_INTS_mpz_clear(&arb_arg1); |
| 1830 | string_arg = Tcl_GetString(objv[2]); | GMP_INTS_mpz_clear(&arb_result); |
| 1831 | assert(string_arg != NULL); | |
| 1832 | return(TCL_OK); | |
| 1833 | //Try to look up the string argument in the table. | } |
| 1834 | tbl_idx = -1; | |
| 1835 | for (i=0; i<sizeof(tbl)/sizeof(tbl[0]); i++) | //Try to convert the first string into arbitrary integers. |
| 1836 | { | //The first string can be anything, including zero or a negative |
| 1837 | if (!strcmp(string_arg, tbl[i].tag)) | //arugument. |
| 1838 | { | GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, str_arg1); |
| 1839 | tbl_idx = i; | |
| 1840 | break; | //If the conversion of the first string did not go alright, |
| 1841 | } | //print error message and abort. |
| 1842 | } | if (failure1) |
| 1843 | { | |
| 1844 | //If the tag was not found in the table, print a hostile | rv = Tcl_NewStringObj("arbint intexp: \"", -1); |
| 1845 | //message and abort. | Tcl_AppendToObj(rv, str_arg1, -1); |
| 1846 | if (tbl_idx == -1) | Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1); |
| 1847 | { | Tcl_SetObjResult(interp, rv); |
| 1848 | char buf[100]; | |
| 1849 | GMP_INTS_mpz_clear(&arb_arg1); | |
| 1850 | //Error case. Must give error message. | GMP_INTS_mpz_clear(&arb_result); |
| 1851 | //Must also list the constants available. | |
| 1852 | rv = Tcl_NewStringObj("arbint const: \"", -1); | return(TCL_ERROR); |
| 1853 | Tcl_AppendToObj(rv, string_arg, -1); | } |
| 1854 | Tcl_AppendToObj(rv, "\" is not a recognized constant.\n", -1); | |
| 1855 | ||
| 1856 | Tcl_AppendToObj(rv, "Available constants are:\n", -1); | //Try to convert the second string into an unsigned 32-bit |
| 1857 | //integer. | |
| 1858 | for (i=0; i<sizeof(tbl)/sizeof(tbl[0]); i++) | GMP_INTS_mpz_parse_into_uint32(&arg2, &failure2, str_arg2); |
| 1859 | { | |
| 1860 | Tcl_AppendToObj(rv, " ", -1); | //If the conversion of the second string did not go alright, |
| 1861 | Tcl_AppendToObj(rv, tbl[i].tag, -1); | //print error message and abort. |
| 1862 | sprintf(buf, " (%d digits available)\n", | if (failure2) |
| 1863 | strlen(tbl[i].minmant) + strlen(tbl[i].mantrem) - tbl[i].digit_count_offset); | { |
| 1864 | Tcl_AppendToObj(rv, buf, -1); | rv = Tcl_NewStringObj("arbint intexp: \"", -1); |
| 1865 | Tcl_AppendToObj(rv, tbl[i].desc, -1); | Tcl_AppendToObj(rv, str_arg2, -1); |
| 1866 | if (i != (sizeof(tbl)/sizeof(tbl[0]) - 1)) | Tcl_AppendToObj(rv, "\" is not a recognized unsigned 32-bit integer.", -1); |
| 1867 | Tcl_AppendToObj(rv, "\n", -1); | Tcl_SetObjResult(interp, rv); |
| 1868 | } | |
| 1869 | GMP_INTS_mpz_clear(&arb_arg1); | |
| 1870 | Tcl_SetObjResult(interp, rv); | GMP_INTS_mpz_clear(&arb_result); |
| 1871 | return(TCL_ERROR); | |
| 1872 | } | return(TCL_ERROR); |
| 1873 | } | |
| 1874 | //Make assertions about the string pointers. | |
| 1875 | assert(tbl[tbl_idx].tag != NULL); | //Calculate the exponential. |
| 1876 | assert(tbl[tbl_idx].desc != NULL); | GMP_INTS_mpz_pow_ui(&arb_result, &arb_arg1, arg2); |
| 1877 | assert(tbl[tbl_idx].minmant != NULL); | |
| 1878 | assert(tbl[tbl_idx].mantrem != NULL); | //Figure out the number of characters required for |
| 1879 | //the output string. | |
| 1880 | //Assume the default number of digits by default. | chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result); |
| 1881 | ndigits = tbl[tbl_idx].deflen; | |
| 1882 | //Allocate space for the conversion result. | |
| 1883 | //If there is an additional parameter, try to interpret | string_result = TclpAlloc(sizeof(char) * chars_reqd); |
| 1884 | //that as the number of digits. | assert(string_result != NULL); |
| 1885 | if (objc == 4) | |
| 1886 | { | //Make the conversion to a character string. |
| 1887 | //SetIntFromAny(interp, objPtr) | GMP_INTS_mpz_to_string(string_result, &arb_result); |
| 1888 | result_code = Tcl_GetIntFromObj(NULL, objv[3], &ndigits); | |
| 1889 | //Assign the string result to a Tcl object. | |
| 1890 | if (result_code != TCL_OK) | rv = Tcl_NewStringObj(string_result, -1); |
| 1891 | { | |
| 1892 | //Could not obtain an integer. Use hostile error | //Deallocate the string. |
| 1893 | //message and abort. | TclpFree(string_result); |
| 1894 | string_arg = Tcl_GetString(objv[3]); | |
| 1895 | assert(string_arg != NULL); | //Deallocate space for the arbitrary-length integers. |
| 1896 | GMP_INTS_mpz_clear(&arb_arg1); | |
| 1897 | rv = Tcl_NewStringObj("arbint const: \"", -1); | GMP_INTS_mpz_clear(&arb_result); |
| 1898 | Tcl_AppendToObj(rv, string_arg, -1); | |
| 1899 | Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1); | //Assign the result to be the return value. |
| 1900 | Tcl_SetObjResult(interp, rv); | Tcl_SetObjResult(interp, rv); |
| 1901 | return(TCL_ERROR); | |
| 1902 | } | //Return |
| 1903 | } | return(TCL_OK); |
| 1904 | } | |
| 1905 | //Ndigits may be corrupt. We have to be careful below to not | } |
| 1906 | //allow any funny stuff. | |
| 1907 | rv = Tcl_NewStringObj(tbl[tbl_idx].minmant, -1); | |
| 1908 | ndigits = ndigits - strlen(tbl[tbl_idx].minmant) + tbl[tbl_idx].digit_count_offset; | //Handles the "intfac" subextension. |
| 1909 | if (ndigits > 0) | //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this |
| 1910 | { | //from memory an intuition as far as how to set return results and so forth. |
| 1911 | if (ndigits >= (int)strlen(tbl[tbl_idx].mantrem)) | static |
| 1912 | { | int ARBLENINTS_intfac_handler(ClientData dummy, |
| 1913 | Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, -1); | Tcl_Interp *interp, |
| 1914 | } | int objc, |
| 1915 | else | Tcl_Obj *objv[]) |
| 1916 | { | { |
| 1917 | Tcl_AppendToObj(rv, tbl[tbl_idx].mantrem, ndigits); | Tcl_Obj *rv; |
| 1918 | } | |
| 1919 | } | //We must have one and exactly one additional argument |
| 1920 | //to this function, which is the integer whose | |
| 1921 | //Append the exponent portion. | //factorial is to be evaluated. |
| 1922 | if (tbl[tbl_idx].exp) | if (objc != 3) |
| 1923 | Tcl_AppendToObj(rv, tbl[tbl_idx].exp, -1); | { |
| 1924 | Tcl_WrongNumArgs(interp, | |
| 1925 | //Default successful return. | 2, |
| 1926 | Tcl_SetObjResult(interp, rv); | objv, |
| 1927 | return(TCL_OK); | "uint32"); |
| 1928 | } | return(TCL_ERROR); |
| 1929 | } | } |
| 1930 | else | |
| 1931 | { | |
| 1932 | //Handles the "decommanate" subextension. | GMP_INTS_mpz_struct arb_result; |
| 1933 | //07/29/01: Visual inspection OK. Have not located my Tcl book, am doing this | char *fac_arg; |
| 1934 | //from memory an intuition as far as how to set return results and so forth. | int failure; |
| 1935 | static | unsigned fac_ui_arg; |
| 1936 | int ARBLENINTS_decommanate_handler(ClientData dummy, | unsigned chars_reqd; |
| 1937 | Tcl_Interp *interp, | char *string_result; |
| 1938 | int objc, | int i; |
| 1939 | Tcl_Obj *objv[]) | |
| 1940 | { | //Allocate space for the arbitrary-length integer result. |
| 1941 | Tcl_Obj *rv; | GMP_INTS_mpz_init(&arb_result); |
| 1942 | ||
| 1943 | //We must have one and exactly one additional argument | //Grab a pointer to the string representation of |
| 1944 | //to this function, which is the string we want to | //the input argument. The storage does not belong to us. |
| 1945 | //decommanate. | fac_arg = Tcl_GetString(objv[2]); |
| 1946 | if (objc != 3) | assert(fac_arg != NULL); |
| 1947 | { | |
| 1948 | Tcl_WrongNumArgs(interp, | //Try to interpret the string as one of the NAN tags. |
| 1949 | 2, | //If it is one, return the appropriate result for |
| 1950 | objv, | //a unary operation. |
| 1951 | "sint"); | if ((i = GMP_INTS_identify_nan_string(fac_arg)) >= 0) |
| 1952 | return(TCL_ERROR); | { |
| 1953 | } | const char *p; |
| 1954 | else | |
| 1955 | { | switch (i) |
| 1956 | char *string_arg; | { |
| 1957 | case 0: p = GMP_INTS_supply_nan_string(2); | |
| 1958 | //Grab a pointer to the string representation of | break; |
| 1959 | //the input argument. The storage does not belong to us. | case 1: p = GMP_INTS_supply_nan_string(3); |
| 1960 | string_arg = Tcl_GetString(objv[2]); | break; |
| 1961 | assert(string_arg != NULL); | case 2: p = GMP_INTS_supply_nan_string(2); |
| 1962 | break; | |
| 1963 | //Try to parse the string as one of the error tags. | case 3: p = GMP_INTS_supply_nan_string(3); |
| 1964 | //If it is one of those, it isn't an error, but don't | break; |
| 1965 | //want to touch the string. | default: |
| 1966 | if (GMP_INTS_identify_nan_string(string_arg) >= 0) | assert(0); |
| 1967 | { | break; |
| 1968 | rv = Tcl_NewStringObj(string_arg, -1); | } |
| 1969 | Tcl_SetObjResult(interp, rv); | |
| 1970 | return(TCL_OK); | rv = Tcl_NewStringObj(p, -1); |
| 1971 | } | Tcl_SetObjResult(interp, rv); |
| 1972 | //Try to parse it as a signed integer without commas. | GMP_INTS_mpz_clear(&arb_result); |
| 1973 | //If it has no commas, there is no need to decommanate it. | return(TCL_OK); |
| 1974 | else if (BSTRFUNC_is_sint_wo_commas(string_arg)) | } |
| 1975 | { | |
| 1976 | //This is already an acceptable commanated signed integer. Send it | //Try to convert the string to a UINT32 using all |
| 1977 | //back as the return value. | //known methods. |
| 1978 | rv = Tcl_NewStringObj(string_arg, -1); | GMP_INTS_mpz_parse_into_uint32(&fac_ui_arg, &failure, fac_arg); |
| 1979 | Tcl_SetObjResult(interp, rv); | |
| 1980 | return(TCL_OK); | //If there was a parse failure, we have to return an error |
| 1981 | } | //message. |
| 1982 | //Try to parse the argument as a signed integer with commas. | if (failure) |
| 1983 | //If it is one of those, decommanate it and return it. | { |
| 1984 | else if (BSTRFUNC_is_sint_w_commas(string_arg)) | rv = Tcl_NewStringObj("arbint intfac: \"", -1); |
| 1985 | { | Tcl_AppendToObj(rv, fac_arg, -1); |
| 1986 | size_t len; | Tcl_AppendToObj(rv, "\" is not a recognized 32-bit unsigned integer.", -1); |
| 1987 | char *buffer; | Tcl_SetObjResult(interp, rv); |
| 1988 | GMP_INTS_mpz_clear(&arb_result); | |
| 1989 | len = strlen(string_arg); | return(TCL_ERROR); |
| 1990 | buffer = TclpAlloc(sizeof(char) * len + 1); | } |
| 1991 | strcpy(buffer, string_arg); | |
| 1992 | BSTRFUNC_decommanate(buffer); | //Calculate the factorial. |
| 1993 | rv = Tcl_NewStringObj(buffer, -1); | GMP_INTS_mpz_fac_ui(&arb_result, fac_ui_arg); |
| 1994 | TclpFree(buffer); | |
| 1995 | Tcl_SetObjResult(interp, rv); | //Figure out the number of characters required for |
| 1996 | return(TCL_OK); | //the output string. |
| 1997 | } | chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result); |
| 1998 | else | |
| 1999 | { | //Allocate space for the conversion result. |
| 2000 | //Error case. Must give error message. | string_result = TclpAlloc(sizeof(char) * chars_reqd); |
| 2001 | rv = Tcl_NewStringObj("arbint decommanate: \"", -1); | assert(string_result != NULL); |
| 2002 | Tcl_AppendToObj(rv, string_arg, -1); | |
| 2003 | Tcl_AppendToObj(rv, "\" is not a recognized integer.", -1); | //Make the conversion to a character string. |
| 2004 | Tcl_SetObjResult(interp, rv); | GMP_INTS_mpz_to_string(string_result, &arb_result); |
| 2005 | return(TCL_ERROR); | |
| 2006 | } | //Assign the string result to a Tcl object. |
| 2007 | } | rv = Tcl_NewStringObj(string_result, -1); |
| 2008 | } | |
| 2009 | //Deallocate the string. | |
| 2010 | TclpFree(string_result); | |
| 2011 | //Handles the "intadd" subextension. | |
| 2012 | //08/06/01: Visual inspection OK. | //Deallocate space for the arbitrary-length integer. |
| 2013 | static | GMP_INTS_mpz_clear(&arb_result); |
| 2014 | int ARBLENINTS_intadd_handler(ClientData dummy, | |
| 2015 | Tcl_Interp *interp, | //Assign the result to be the return value. |
| 2016 | int objc, | Tcl_SetObjResult(interp, rv); |
| 2017 | Tcl_Obj *objv[]) | |
| 2018 | { | //Return |
| 2019 | Tcl_Obj *rv; | return(TCL_OK); |
| 2020 | } | |
| 2021 | //We must have two and exactly two additional arguments | } |
| 2022 | //to this function, which are the integers whose | |
| 2023 | //sum is to be calculated. | |
| 2024 | if (objc != 4) | //Handles the "intgcd" subextension. |
| 2025 | { | //08/06/01: Visual inspection OK. |
| 2026 | Tcl_WrongNumArgs(interp, | static |
| 2027 | 2, | int ARBLENINTS_intgcd_handler(ClientData dummy, |
| 2028 | objv, | Tcl_Interp *interp, |
| 2029 | "sint sint"); | int objc, |
| 2030 | return(TCL_ERROR); | Tcl_Obj *objv[]) |
| 2031 | } | { |
| 2032 | else | Tcl_Obj *rv; |
| 2033 | { | |
| 2034 | GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result; | //We must have two and exactly two additional arguments |
| 2035 | char *add_arg1, *add_arg2; | //to this function, which are the integers whose |
| 2036 | int failure1, failure2; | //gcd is to be calculated. |
| 2037 | unsigned chars_reqd; | if (objc != 4) |
| 2038 | char *string_result; | { |
| 2039 | int i, j; | Tcl_WrongNumArgs(interp, |
| 2040 | 2, | |
| 2041 | //Allocate space for the arbitrary-length integer result. | objv, |
| 2042 | GMP_INTS_mpz_init(&arb_arg1); | "sint sint"); |
| 2043 | GMP_INTS_mpz_init(&arb_arg2); | return(TCL_ERROR); |
| 2044 | GMP_INTS_mpz_init(&arb_result); | } |
| 2045 | else | |
| 2046 | //Grab pointers to the string representation of | { |
| 2047 | //the input arguments. The storage does not belong to us. | GMP_INTS_mpz_struct arb_arg1, arb_arg2, arb_result; |
| 2048 | add_arg1 = Tcl_GetString(objv[2]); | char *gcd_arg1, *gcd_arg2; |
| 2049 | assert(add_arg1 != NULL); | int failure1, failure2; |
| 2050 | add_arg2 = Tcl_GetString(objv[3]); | unsigned chars_reqd; |
| 2051 | assert(add_arg2 != NULL); | char *string_result; |
| 2052 | int i, j; | |
| 2053 | //Try to interpret either of the strings as one of the NAN tags. | |
| 2054 | //If it is one, return the appropriate result for | //Allocate space for the arbitrary-length integer result. |
| 2055 | //a binary operation. | GMP_INTS_mpz_init(&arb_arg1); |
| 2056 | i = GMP_INTS_identify_nan_string(add_arg1); | GMP_INTS_mpz_init(&arb_arg2); |
| 2057 | j = GMP_INTS_identify_nan_string(add_arg2); | GMP_INTS_mpz_init(&arb_result); |
| 2058 | ||
| 2059 | if ((i >= 0) || (j >= 0)) | //Grab pointers to the string representation of |
| 2060 | { | //the input arguments. The storage does not belong to us. |
| 2061 | const char *p; | gcd_arg1 = Tcl_GetString(objv[2]); |
| 2062 | assert(gcd_arg1 != NULL); | |
| 2063 | //Find the max of i and j. This isn't a scientific way to tag the | gcd_arg2 = Tcl_GetString(objv[3]); |
| 2064 | //result, but will be OK. Some information is lost no matter what | assert(gcd_arg2 != NULL); |
| 2065 | //we do. | |
| 2066 | if (i > j) | //Try to interpret either of the strings as one of the NAN tags. |
| 2067 | ; | //If it is one, return the appropriate result for |
| 2068 | else | //a binary operation. |
| 2069 | i = j; | i = GMP_INTS_identify_nan_string(gcd_arg1); |
| 2070 | j = GMP_INTS_identify_nan_string(gcd_arg2); | |
| 2071 | //i now contains the max. | |
| 2072 | switch (i) | if ((i >= 0) || (j >= 0)) |
| 2073 | { | { |
| 2074 | case 0: p = GMP_INTS_supply_nan_string(2); | const char *p; |
| 2075 | break; | |
| 2076 | case 1: p = GMP_INTS_supply_nan_string(3); | //Find the max of i and j. This isn't a scientific way to tag the |
| 2077 | break; | //result, but will be OK. Some information is lost no matter what |
| 2078 | case 2: p = GMP_INTS_supply_nan_string(2); | //we do. |
| 2079 | break; | if (i > j) |
| 2080 | case 3: p = GMP_INTS_supply_nan_string(3); | ; |
| 2081 | break; | else |
| 2082 | default: | i = j; |
| 2083 | assert(0); | |
| 2084 | break; | //i now contains the max. |
| 2085 | } | switch (i) |
| 2086 | { | |
| 2087 | rv = Tcl_NewStringObj(p, -1); | case 0: p = GMP_INTS_supply_nan_string(2); |
| 2088 | Tcl_SetObjResult(interp, rv); | break; |
| 2089 | case 1: p = GMP_INTS_supply_nan_string(3); | |
| 2090 | GMP_INTS_mpz_clear(&arb_arg1); | break; |
| 2091 | GMP_INTS_mpz_clear(&arb_arg2); | case 2: p = GMP_INTS_supply_nan_string(2); |
| 2092 | GMP_INTS_mpz_clear(&arb_result); | break; |
| 2093 | case 3: p = GMP_INTS_supply_nan_string(3); | |
| 2094 | return(TCL_OK); | break; |
| 2095 | } | default: |
| 2096 | assert(0); | |
| 2097 | //Try to convert both strings into arbitrary integers. | break; |
| 2098 | GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, add_arg1); | } |
| 2099 | GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, add_arg2); | |
| 2100 | rv = Tcl_NewStringObj(p, -1); | |
| 2101 | //If there was a parse failure, we have to return an error | Tcl_SetObjResult(interp, rv); |
| 2102 | //message. It is possible that both arguments failed the parse, | |
| 2103 | //but only return one in the error message. | GMP_INTS_mpz_clear(&arb_arg1); |
| 2104 | if (failure1 || failure2) | GMP_INTS_mpz_clear(&arb_arg2); |
| 2105 | { | GMP_INTS_mpz_clear(&arb_result); |
| 2106 | rv = Tcl_NewStringObj("arbint intadd: \"", -1); | |
| 2107 | if (failure1) | return(TCL_OK); |
| 2108 | Tcl_AppendToObj(rv, add_arg1, -1); | } |
| 2109 | else | |
| 2110 | Tcl_AppendToObj(rv, add_arg2, -1); | //Try to convert both strings into arbitrary integers. |
| 2111 | GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, gcd_arg1); | |
| 2112 | Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1); | GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, gcd_arg2); |
| 2113 | Tcl_SetObjResult(interp, rv); | |
| 2114 | //If there was a parse failure, we have to return an error | |
| 2115 | GMP_INTS_mpz_clear(&arb_arg1); | //message. It is possible that both arguments failed the parse, |
| 2116 | GMP_INTS_mpz_clear(&arb_arg2); | //but only return one in the error message. |
| 2117 | GMP_INTS_mpz_clear(&arb_result); | if (failure1 || failure2) |
| 2118 | { | |
| 2119 | return(TCL_ERROR); | rv = Tcl_NewStringObj("arbint intgcd: \"", -1); |
| 2120 | } | if (failure1) |
| 2121 | Tcl_AppendToObj(rv, gcd_arg1, -1); | |
| 2122 | //Calculate the sum. | else |
| 2123 | GMP_INTS_mpz_add(&arb_result, &arb_arg1, &arb_arg2); | Tcl_AppendToObj(rv, gcd_arg2, -1); |
| 2124 | ||
| 2125 | //Figure out the number of characters required for | Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1); |
| 2126 | //the output string. | Tcl_SetObjResult(interp, rv); |
| 2127 | chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result); | |
| 2128 | GMP_INTS_mpz_clear(&arb_arg1); | |
| 2129 | //Allocate space for the conversion result. | GMP_INTS_mpz_clear(&arb_arg2); |
| 2130 | string_result = TclpAlloc(sizeof(char) * chars_reqd); | GMP_INTS_mpz_clear(&arb_result); |
| 2131 | assert(string_result != NULL); | |
| 2132 | return(TCL_ERROR); | |
| 2133 | //Make the conversion to a character string. | } |
| 2134 | GMP_INTS_mpz_to_string(string_result, &arb_result); | |
| 2135 | //Calculate the gcd. | |
| 2136 | //Assign the string result to a Tcl object. | GMP_INTS_mpz_gcd(&arb_result, &arb_arg1, &arb_arg2); |
| 2137 | rv = Tcl_NewStringObj(string_result, -1); | |
| 2138 | //Figure out the number of characters required for | |
| 2139 | //Deallocate the string. | //the output string. |
| 2140 | TclpFree(string_result); | chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result); |
| 2141 | ||
| 2142 | //Deallocate space for the arbitrary-length integers. | //Allocate space for the conversion result. |
| 2143 | GMP_INTS_mpz_clear(&arb_arg1); | string_result = TclpAlloc(sizeof(char) * chars_reqd); |
| 2144 | GMP_INTS_mpz_clear(&arb_arg2); | assert(string_result != NULL); |
| 2145 | GMP_INTS_mpz_clear(&arb_result); | |
| 2146 | //Make the conversion to a character string. | |
| 2147 | //Assign the result to be the return value. | GMP_INTS_mpz_to_string(string_result, &arb_result); |
| 2148 | Tcl_SetObjResult(interp, rv); | |
| 2149 | //Assign the string result to a Tcl object. | |
| 2150 | //Return | rv = Tcl_NewStringObj(string_result, -1); |
| 2151 | return(TCL_OK); | |
| 2152 | } | //Deallocate the string. |
| 2153 | } | TclpFree(string_result); |
| 2154 | ||
| 2155 | //Deallocate space for the arbitrary-length integers. | |
| 2156 | //08/01/01: Visual inspection and some unit testing, OK. | GMP_INTS_mpz_clear(&arb_arg1); |
| 2157 | //Handles the "intcmp" subextension. | GMP_INTS_mpz_clear(&arb_arg2); |
| 2158 | static | GMP_INTS_mpz_clear(&arb_result); |
| 2159 | int ARBLENINTS_intcmp_handler(ClientData dummy, | |
| 2160 | Tcl_Interp *interp, | //Assign the result to be the return value. |
| 2161 | int objc, | Tcl_SetObjResult(interp, rv); |
| 2162 | Tcl_Obj *objv[]) | |
| 2163 | { | //Return |
| 2164 | Tcl_Obj *rv; | return(TCL_OK); |
| 2165 | } | |
| 2166 | //We must have two and exactly two additional arguments | } |
| 2167 | //to this function, which are the integers to be compared. | |
| 2168 | if (objc != 4) | |
| 2169 | { | //Handles the "intlcm" subextension. |
| 2170 | Tcl_WrongNumArgs(interp, | //08/10/01: Visual inspection OK. |
| 2171 | 2, | static |
| 2172 | objv, | int ARBLENINTS_intlcm_handler(ClientData dummy, |
| 2173 | "sint sint"); | Tcl_Interp *interp, |
| 2174 | return(TCL_ERROR); | int objc, |
| 2175 | } | Tcl_Obj *objv[]) |
| 2176 | else | { |
| 2177 | { | Tcl_Obj *rv; |
| 2178 | GMP_INTS_mpz_struct arb_arg1, arb_arg2; | |
| 2179 | char *cmp_arg1, *cmp_arg2; | //We must have two and exactly two additional arguments |
| 2180 | int failure1, failure2; | //to this function, which are the integers whose |
| 2181 | int i, j, compare_result; | //lcm is to be calculated. |
| 2182 | if (objc != 4) | |
| 2183 | //Allocate space for the arbitrary-length integer result. | { |
| 2184 | GMP_INTS_mpz_init(&arb_arg1); | Tcl_WrongNumArgs(interp, |
| 2185 | GMP_INTS_mpz_init(&arb_arg2); | 2, |
| 2186 | objv, | |
| 2187 | //Grab pointers to the string representation of | "sint sint"); |
| 2188 | //the input arguments. The storage does not belong to us. | return(TCL_ERROR); |
| 2189 | cmp_arg1 = Tcl_GetString(objv[2]); | } |
| 2190 | assert(cmp_arg1 != NULL); | else |
| 2191 | cmp_arg2 = Tcl_GetString(objv[3]); | { |
| 2192 | assert(cmp_arg2 != NULL); | GMP_INTS_mpz_struct arb_arg1, arb_arg2, gcd, remainder, arb_result; |
| 2193 | char *lcm_arg1, *lcm_arg2; | |
| 2194 | //Try to interpret either of the strings as one of the NAN tags. | int failure1, failure2; |
| 2195 | //We cannot compare NAN tags. If either is a NAN tag, we must signal an | unsigned chars_reqd; |
| 2196 | //error. | char *string_result; |
| 2197 | i = GMP_INTS_identify_nan_string(cmp_arg1); | int i, j; |
| 2198 | j = GMP_INTS_identify_nan_string(cmp_arg2); | |
| 2199 | //Allocate space for the arbitrary-length integers. | |
| 2200 | if ((i >= 0) || (j >= 0)) | GMP_INTS_mpz_init(&arb_arg1); |
| 2201 | { | GMP_INTS_mpz_init(&arb_arg2); |
| 2202 | rv = Tcl_NewStringObj("arbint intcmp: cannot compare NAN symbolic tags.", -1); | GMP_INTS_mpz_init(&gcd); |
| 2203 | Tcl_SetObjResult(interp, rv); | GMP_INTS_mpz_init(&remainder); |
| 2204 | GMP_INTS_mpz_init(&arb_result); | |
| 2205 | GMP_INTS_mpz_clear(&arb_arg1); | |
| 2206 | GMP_INTS_mpz_clear(&arb_arg2); | //Grab pointers to the string representation of |
| 2207 | //the input arguments. The storage does not belong to us. | |
| 2208 | return(TCL_ERROR); | lcm_arg1 = Tcl_GetString(objv[2]); |
| 2209 | } | assert(lcm_arg1 != NULL); |
| 2210 | lcm_arg2 = Tcl_GetString(objv[3]); | |
| 2211 | //Try to convert both strings into arbitrary integers. | assert(lcm_arg2 != NULL); |
| 2212 | GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, cmp_arg1); | |
| 2213 | GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, cmp_arg2); | //Try to interpret either of the strings as one of the NAN tags. |
| 2214 | //If it is one, return the appropriate result for | |
| 2215 | //If there was a parse failure, we have to return an error | //a binary operation. |
| 2216 | //message. It is possible that both arguments failed the parse, | i = GMP_INTS_identify_nan_string(lcm_arg1); |
| 2217 | //but only return one in the error message. | j = GMP_INTS_identify_nan_string(lcm_arg2); |
| 2218 | if (failure1 || failure2) | |
| 2219 | { | if ((i >= 0) || (j >= 0)) |
| 2220 | rv = Tcl_NewStringObj("arbint intcmp: \"", -1); | { |
| 2221 | if (failure1) | const char *p; |
| 2222 | Tcl_AppendToObj(rv, cmp_arg1, -1); | |
| 2223 | else | //Find the max of i and j. This isn't a scientific way to tag the |
| 2224 | Tcl_AppendToObj(rv, cmp_arg2, -1); | //result, but will be OK. Some information is lost no matter what |
| 2225 | //we do. | |
| 2226 | Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1); | if (i > j) |
| 2227 | Tcl_SetObjResult(interp, rv); | ; |
| 2228 | else | |
| 2229 | GMP_INTS_mpz_clear(&arb_arg1); | i = j; |
| 2230 | GMP_INTS_mpz_clear(&arb_arg2); | |
| 2231 | //i now contains the max. | |
| 2232 | return(TCL_ERROR); | switch (i) |
| 2233 | } | { |
| 2234 | case 0: p = GMP_INTS_supply_nan_string(2); | |
| 2235 | //Calculate the compare result. | break; |
| 2236 | compare_result = GMP_INTS_mpz_cmp(&arb_arg1, &arb_arg2); | case 1: p = GMP_INTS_supply_nan_string(3); |
| 2237 | break; | |
| 2238 | //Assign the return value based on the result. | case 2: p = GMP_INTS_supply_nan_string(2); |
| 2239 | if (compare_result < 0) | break; |
| 2240 | rv = Tcl_NewStringObj("-1", -1); | case 3: p = GMP_INTS_supply_nan_string(3); |
| 2241 | else if (compare_result == 0) | break; |
| 2242 | rv = Tcl_NewStringObj("0", -1); | default: |
| 2243 | else | assert(0); |
| 2244 | rv = Tcl_NewStringObj("1", -1); | break; |
| 2245 | } | |
| 2246 | //Deallocate space for the arbitrary-length integers. | |
| 2247 | GMP_INTS_mpz_clear(&arb_arg1); | rv = Tcl_NewStringObj(p, -1); |
| 2248 | GMP_INTS_mpz_clear(&arb_arg2); | Tcl_SetObjResult(interp, rv); |
| 2249 | ||
| 2250 | //Assign the result to be the return value. | GMP_INTS_mpz_clear(&arb_arg1); |
| 2251 | Tcl_SetObjResult(interp, rv); | GMP_INTS_mpz_clear(&arb_arg2); |
| 2252 | GMP_INTS_mpz_clear(&gcd); | |
| 2253 | //Return | GMP_INTS_mpz_clear(&remainder); |
| 2254 | return(TCL_OK); | GMP_INTS_mpz_clear(&arb_result); |
| 2255 | } | |
| 2256 | } | return(TCL_OK); |
| 2257 | } | |
| 2258 | ||
| 2259 | //Handles the "intdiv" subextension. | //Try to convert both strings into arbitrary integers. |
| 2260 | //07/31/01: Visually inspected, OK. | GMP_INTS_mpz_set_general_int(&arb_arg1, &failure1, lcm_arg1); |
| 2261 | static | GMP_INTS_mpz_set_general_int(&arb_arg2, &failure2, lcm_arg2); |
| 2262 | int ARBLENINTS_intdiv_handler(ClientData dummy, | |
| 2263 | Tcl_Interp *interp, | //If there was a parse failure, we have to return an error |
| 2264 | int objc, | //message. It is possible that both arguments failed the parse, |
| 2265 | Tcl_Obj *objv[]) | //but only return one in the error message. |
| 2266 | { | if (failure1 || failure2) |
| 2267 | Tcl_Obj *rv; | { |
| 2268 | rv = Tcl_NewStringObj("arbint intlcm: \"", -1); | |
| 2269 | //We must have two and exactly two additional arguments | if (failure1) |
| 2270 | //to this function, which are the integers whose | Tcl_AppendToObj(rv, lcm_arg1, -1); |
| 2271 | //integer quotient is to be calculated. | else |
| 2272 | if (objc != 4) | Tcl_AppendToObj(rv, lcm_arg2, -1); |
| 2273 | { | |
| 2274 | Tcl_WrongNumArgs(interp, | Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1); |
| 2275 | 2, | Tcl_SetObjResult(interp, rv); |
| 2276 | objv, | |
| 2277 | "sint sint"); | GMP_INTS_mpz_clear(&arb_arg1); |
| 2278 | return(TCL_ERROR); | GMP_INTS_mpz_clear(&arb_arg2); |
| 2279 | } | GMP_INTS_mpz_clear(&gcd); |
| 2280 | else | GMP_INTS_mpz_clear(&remainder); |
| 2281 | { | GMP_INTS_mpz_clear(&arb_result); |
| 2282 | GMP_INTS_mpz_struct arb_dividend, arb_divisor, arb_quotient, arb_remainder; | |
| 2283 | char *dividend_arg1, *divisor_arg2; | return(TCL_ERROR); |
| 2284 | int failure1, failure2; | } |
| 2285 | unsigned chars_reqd; | |
| 2286 | char *string_result; | //Adjust errant arguments. |
| 2287 | int i, j; | if (GMP_INTS_mpz_is_neg(&arb_arg1)) |
| 2288 | GMP_INTS_mpz_negate(&arb_arg1); | |
| 2289 | //Allocate space for the arbitrary-length integer arguments and results. | else if (GMP_INTS_mpz_is_zero(&arb_arg1)) |
| 2290 | GMP_INTS_mpz_init(&arb_dividend); | GMP_INTS_mpz_set_ui(&arb_arg1, 1); |
| 2291 | GMP_INTS_mpz_init(&arb_divisor); | if (GMP_INTS_mpz_is_neg(&arb_arg2)) |
| 2292 | GMP_INTS_mpz_init(&arb_quotient); | GMP_INTS_mpz_negate(&arb_arg2); |
| 2293 | GMP_INTS_mpz_init(&arb_remainder); | else if (GMP_INTS_mpz_is_zero(&arb_arg2)) |
| 2294 | GMP_INTS_mpz_set_ui(&arb_arg2, 1); | |
| 2295 | //Grab pointers to the string representation of | |
| 2296 | //the input arguments. The storage does not belong to us. | //Calculate the gcd. |
| 2297 | dividend_arg1 = Tcl_GetString(objv[2]); | GMP_INTS_mpz_gcd(&gcd, &arb_arg1, &arb_arg2); |
| 2298 | assert(dividend_arg1 != NULL); | |
| 2299 | divisor_arg2 = Tcl_GetString(objv[3]); | //Calculate the lcm. |
| 2300 | assert(divisor_arg2 != NULL); | GMP_INTS_mpz_mul(&arb_arg1, &arb_arg1, &arb_arg2); |
| 2301 | GMP_INTS_mpz_tdiv_qr(&arb_result, &remainder, | |
| 2302 | //Try to interpret either of the strings as one of the NAN tags. | &arb_arg1, &gcd); |
| 2303 | //If it is one, return the appropriate result for | |
| 2304 | //a binary operation. | //Figure out the number of characters required for |
| 2305 | i = GMP_INTS_identify_nan_string(dividend_arg1); | //the output string. |
| 2306 | j = GMP_INTS_identify_nan_string(divisor_arg2); | chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_result); |
| 2307 | ||
| 2308 | if ((i >= 0) || (j >= 0)) | //Allocate space for the conversion result. |
| 2309 | { | string_result = TclpAlloc(sizeof(char) * chars_reqd); |
| 2310 | const char *p; | assert(string_result != NULL); |
| 2311 | ||
| 2312 | //Find the max of i and j. This isn't a scientific way to tag the | //Make the conversion to a character string. |
| 2313 | //result, but will be OK. Some information is lost no matter what | GMP_INTS_mpz_to_string(string_result, &arb_result); |
| 2314 | //we do. | |
| 2315 | if (i > j) | //Assign the string result to a Tcl object. |
| 2316 | ; | rv = Tcl_NewStringObj(string_result, -1); |
| 2317 | else | |
| 2318 | i = j; | //Deallocate the string. |
| 2319 | TclpFree(string_result); | |
| 2320 | //i now contains the max. | |
| 2321 | switch (i) | //Deallocate space for the arbitrary-length integers. |
| 2322 | { | GMP_INTS_mpz_clear(&arb_arg1); |
| 2323 | case 0: p = GMP_INTS_supply_nan_string(2); | GMP_INTS_mpz_clear(&arb_arg2); |
| 2324 | break; | GMP_INTS_mpz_clear(&gcd); |
| 2325 | case 1: p = GMP_INTS_supply_nan_string(3); | GMP_INTS_mpz_clear(&remainder); |
| 2326 | break; | GMP_INTS_mpz_clear(&arb_result); |
| 2327 | case 2: p = GMP_INTS_supply_nan_string(2); | |
| 2328 | break; | //Assign the result to be the return value. |
| 2329 | case 3: p = GMP_INTS_supply_nan_string(3); | Tcl_SetObjResult(interp, rv); |
| 2330 | break; | |
| 2331 | default: | //Return |
| 2332 | assert(0); | return(TCL_OK); |
| 2333 | break; | } |
| 2334 | } | } |
| 2335 | ||
| 2336 | rv = Tcl_NewStringObj(p, -1); | |
| 2337 | Tcl_SetObjResult(interp, rv); | //Handles the "intmod" subextension. |
| 2338 | //08/06/01: Visual inspection OK. | |
| 2339 | GMP_INTS_mpz_clear(&arb_dividend); | static |
| 2340 | GMP_INTS_mpz_clear(&arb_divisor); | int ARBLENINTS_intmod_handler(ClientData dummy, |
| 2341 | GMP_INTS_mpz_clear(&arb_quotient); | Tcl_Interp *interp, |
| 2342 | GMP_INTS_mpz_clear(&arb_remainder); | int objc, |
| 2343 | Tcl_Obj *objv[]) | |
| 2344 | return(TCL_OK); | { |
| 2345 | } | Tcl_Obj *rv; |
| 2346 | ||
| 2347 | //Try to convert both strings into arbitrary integers. | //We must have two and exactly two additional arguments |
| 2348 | GMP_INTS_mpz_set_general_int(&arb_dividend, &failure1, dividend_arg1); | //to this function, which are the integers whose |
| 2349 | GMP_INTS_mpz_set_general_int(&arb_divisor, &failure2, divisor_arg2); | //integer quotient is to be calculated. |
| 2350 | if (objc != 4) | |
| 2351 | //If there was a parse failure, we have to return an error | { |
| 2352 | //message. It is possible that both arguments failed the parse, | Tcl_WrongNumArgs(interp, |
| 2353 | //but only return one in the error message. | 2, |
| 2354 | if (failure1 || failure2) | objv, |
| 2355 | { | "sint sint"); |
| 2356 | rv = Tcl_NewStringObj("arbint intdiv: \"", -1); | return(TCL_ERROR); |
| 2357 | if (failure1) | } |
| 2358 | Tcl_AppendToObj(rv, dividend_arg1, -1); | else |
| 2359 | else | { |
| 2360 | Tcl_AppendToObj(rv, divisor_arg2, -1); | GMP_INTS_mpz_struct arb_dividend, arb_divisor, arb_quotient, arb_remainder; |
| 2361 | char *dividend_arg1, *divisor_arg2; | |
| 2362 | Tcl_AppendToObj(rv, "\" is not a recognized signed integer.", -1); | int failure1, failure2; |
| 2363 | Tcl_SetObjResult(interp, rv); | unsigned chars_reqd; |
| 2364 | char *string_result; | |
| 2365 | GMP_INTS_mpz_clear(&arb_dividend); | int i, j; |
| 2366 | GMP_INTS_mpz_clear(&arb_divisor); | |
| 2367 | GMP_INTS_mpz_clear(&arb_quotient); | //Allocate space for the arbitrary-length integer arguments and results. |
| 2368 | GMP_INTS_mpz_clear(&arb_remainder); | GMP_INTS_mpz_init(&arb_dividend); |
| 2369 | GMP_INTS_mpz_init(&arb_divisor); | |
| 2370 | return(TCL_ERROR); | GMP_INTS_mpz_init(&arb_quotient); |
| 2371 | } | GMP_INTS_mpz_init(&arb_remainder); |
| 2372 | ||
| 2373 | //Calculate the quotient. | //Grab pointers to the string representation of |
| 2374 | GMP_INTS_mpz_tdiv_qr(&arb_quotient, &arb_remainder, &arb_dividend, &arb_divisor); | //the input arguments. The storage does not belong to us. |
| 2375 | dividend_arg1 = Tcl_GetString(objv[2]); | |
| 2376 | //Figure out the number of characters required for | assert(dividend_arg1 != NULL); |
| 2377 | //the output string. | divisor_arg2 = Tcl_GetString(objv[3]); |
| 2378 | chars_reqd = GMP_INTS_mpz_size_in_base_10(&arb_quotient); | assert(divisor_arg2 != NULL); |
| 2379 | ||
| 2380 | //Allocate space for the conversion result. | //Try to interpret either of the strings as one of the NAN tags. |
| 2381 | string_result = TclpAlloc(sizeof(char) * chars_reqd); | //If it is one, return the appropriate result for |
| 2382 | assert(string_result != NULL); | //a binary operation. |
| 2383 | i = GMP_INTS_identify_nan_string(dividend_arg1); | |
| 2384 | //Make the conversion to a character string. | j = GMP_INTS_identify_nan_string(divisor_arg2); |
| 2385 | GMP_INTS_mpz_to_string(string_result, &arb_quotient); | |
| 2386 | if ((i >= 0) || (j >= 0)) | |
| 2387 | //Assign the string result to a Tcl object. | { |
| 2388 | rv = Tcl_NewStringObj(string_result, -1); | const char *p; |
| 2389 | ||
| 2390 | //Deallocate the string. | //Find the max of i and j. This isn't a scientific way to tag the |
| 2391 | TclpFree(string_result); | //result, but will be OK. Some information is lost no matter what |
| 2392 | //we do. | |
| 2393 | //Deallocate space for the arbitrary-length integers. | if (i > j) |
| 2394 | GMP_INTS_mpz_clear(&arb_dividend); | ; |
| 2395 | GMP_INTS_mpz_clear(&arb_divisor); | else |
| 2396 | GMP_INTS_mpz_clear(&arb_quotient); | i = j; |
| 2397 | GMP_INTS_mpz_clear(&arb_remainder); | |
| 2398 | //i now contains the max. | |
| 2399 | //Assign the result to be the return value. | switch (i) |
| 2400 | Tcl_SetObjResult(interp, rv); | { |
| 2401 | case 0: p = GMP_INTS_supply_nan_string(2); | |
| 2402 | //Return | break; |
| 2403 | return(TCL_OK); | case 1: p = GMP_INTS_supply_nan_string(3); |
| 2404 | } | break; |
| 2405 | } | case 2: p = GMP_INTS_supply_nan_string(2); |
| 2406 | break; | |
| 2407 | case 3: p = GMP_INTS_supply_nan_string(3); | |
| 2408 | //08/01/01: Visually inspected. | break; |
| 2409 | //Handles the "intexp" subextension. | default: |
| 2410 | static | assert(0); |
| 2411 | int ARBLENINTS_intexp_handler(ClientData dummy, | break; |
| 2412 | Tcl_Interp *interp, | } |
| 2413 | int objc, | |
| 2414 | Tcl_Obj *objv[]) | rv = Tcl_NewStringObj(p, -1); |
| 2415 | { | Tcl_SetObjResult(interp, rv); |
| 2416 | Tcl_Obj *rv; | |
| 2417 | GMP_INTS_mpz_clear(&arb_dividend); | |
| 2418 | //We must have two and exactly two additional arguments | GMP_INTS_mpz_clear(&arb_divisor); |
| 2419 | //to this function, which are the integers used to | GMP_INTS_mpz_clear(&arb_quotient); |
| 2420 | //cal |