| OLD | NEW |
| 1 /**************************************************************** | 1 /**************************************************************** |
| 2 * | 2 * |
| 3 * The author of this software is David M. Gay. | 3 * The author of this software is David M. Gay. |
| 4 * | 4 * |
| 5 * Copyright (c) 1991, 2000, 2001 by Lucent Technologies. | 5 * Copyright (c) 1991, 2000, 2001 by Lucent Technologies. |
| 6 * | 6 * |
| 7 * Permission to use, copy, modify, and distribute this software for any | 7 * Permission to use, copy, modify, and distribute this software for any |
| 8 * purpose without fee is hereby granted, provided that this entire notice | 8 * purpose without fee is hereby granted, provided that this entire notice |
| 9 * is included in all copies of any software which is or includes a copy | 9 * is included in all copies of any software which is or includes a copy |
| 10 * or modification of this software and in all copies of the supporting | 10 * or modification of this software and in all copies of the supporting |
| (...skipping 54 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 65 * #define IEEE_8087 for IEEE-arithmetic machines where the least | 65 * #define IEEE_8087 for IEEE-arithmetic machines where the least |
| 66 * significant byte has the lowest address. | 66 * significant byte has the lowest address. |
| 67 * #define IEEE_MC68k for IEEE-arithmetic machines where the most | 67 * #define IEEE_MC68k for IEEE-arithmetic machines where the most |
| 68 * significant byte has the lowest address. | 68 * significant byte has the lowest address. |
| 69 * #define Long int on machines with 32-bit ints and 64-bit longs. | 69 * #define Long int on machines with 32-bit ints and 64-bit longs. |
| 70 * #define IBM for IBM mainframe-style floating-point arithmetic. | 70 * #define IBM for IBM mainframe-style floating-point arithmetic. |
| 71 * #define VAX for VAX-style floating-point arithmetic (D_floating). | 71 * #define VAX for VAX-style floating-point arithmetic (D_floating). |
| 72 * #define No_leftright to omit left-right logic in fast floating-point | 72 * #define No_leftright to omit left-right logic in fast floating-point |
| 73 * computation of dtoa. | 73 * computation of dtoa. |
| 74 * #define Honor_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3 | 74 * #define Honor_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3 |
| 75 *» and strtod and dtoa should round accordingly. | 75 *» and strtod and dtoa should round accordingly. Unless Trust_FLT_ROUNDS |
| 76 *» is also #defined, fegetround() will be queried for the rounding mode. |
| 77 *» Note that both FLT_ROUNDS and fegetround() are specified by the C99 |
| 78 *» standard (and are specified to be consistent, with fesetround() |
| 79 *» affecting the value of FLT_ROUNDS), but that some (Linux) systems |
| 80 *» do not work correctly in this regard, so using fegetround() is more |
| 81 *» portable than using FLT_FOUNDS directly. |
| 76 * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3 | 82 * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3 |
| 77 * and Honor_FLT_ROUNDS is not #defined. | 83 * and Honor_FLT_ROUNDS is not #defined. |
| 78 * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines | 84 * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines |
| 79 * that use extended-precision instructions to compute rounded | 85 * that use extended-precision instructions to compute rounded |
| 80 * products and quotients) with IBM. | 86 * products and quotients) with IBM. |
| 81 * #define ROUND_BIASED for IEEE-format with biased rounding. | 87 * #define ROUND_BIASED for IEEE-format with biased rounding. |
| 82 * #define Inaccurate_Divide for IEEE-format with correctly rounded | 88 * #define Inaccurate_Divide for IEEE-format with correctly rounded |
| 83 * products but inaccurate quotients, e.g., for Intel i860. | 89 * products but inaccurate quotients, e.g., for Intel i860. |
| 84 * #define NO_LONG_LONG on machines that do not have a "long long" | 90 * #define NO_LONG_LONG on machines that do not have a "long long" |
| 85 * integer type (of >= 64 bits). On such machines, you can | 91 * integer type (of >= 64 bits). On such machines, you can |
| 86 * #define Just_16 to store 16 bits per 32-bit Long when doing | 92 * #define Just_16 to store 16 bits per 32-bit Long when doing |
| 87 * high-precision integer arithmetic. Whether this speeds things | 93 * high-precision integer arithmetic. Whether this speeds things |
| 88 * up or slows things down depends on the machine and the number | 94 * up or slows things down depends on the machine and the number |
| 89 * being converted. If long long is available and the name is | 95 * being converted. If long long is available and the name is |
| 90 * something other than "long long", #define Llong to be the name, | 96 * something other than "long long", #define Llong to be the name, |
| 91 * and if "unsigned Llong" does not work as an unsigned version of | 97 * and if "unsigned Llong" does not work as an unsigned version of |
| 92 * Llong, #define #ULLong to be the corresponding unsigned type. | 98 * Llong, #define #ULLong to be the corresponding unsigned type. |
| 93 * #define KR_headers for old-style C function headers. | 99 * #define KR_headers for old-style C function headers. |
| 94 * #define Bad_float_h if your system lacks a float.h or if it does not | 100 * #define Bad_float_h if your system lacks a float.h or if it does not |
| 95 * define some or all of DBL_DIG, DBL_MAX_10_EXP, DBL_MAX_EXP, | 101 * define some or all of DBL_DIG, DBL_MAX_10_EXP, DBL_MAX_EXP, |
| 96 * FLT_RADIX, FLT_ROUNDS, and DBL_MAX. | 102 * FLT_RADIX, FLT_ROUNDS, and DBL_MAX. |
| 97 * #define MALLOC your_malloc, where your_malloc(n) acts like malloc(n) | 103 * #define MALLOC your_malloc, where your_malloc(n) acts like malloc(n) |
| 98 * if memory is available and otherwise does something you deem | 104 * if memory is available and otherwise does something you deem |
| 99 * appropriate. If MALLOC is undefined, malloc will be invoked | 105 * appropriate. If MALLOC is undefined, malloc will be invoked |
| 100 *» directly -- and assumed always to succeed. | 106 *» directly -- and assumed always to succeed. Similarly, if you |
| 107 *» want something other than the system's free() to be called to |
| 108 *» recycle memory acquired from MALLOC, #define FREE to be the |
| 109 *» name of the alternate routine. (FREE or free is only called in |
| 110 *» pathological cases, e.g., in a dtoa call after a dtoa return in |
| 111 *» mode 3 with thousands of digits requested.) |
| 101 * #define Omit_Private_Memory to omit logic (added Jan. 1998) for making | 112 * #define Omit_Private_Memory to omit logic (added Jan. 1998) for making |
| 102 * memory allocations from a private pool of memory when possible. | 113 * memory allocations from a private pool of memory when possible. |
| 103 * When used, the private pool is PRIVATE_MEM bytes long: 2304 bytes, | 114 * When used, the private pool is PRIVATE_MEM bytes long: 2304 bytes, |
| 104 * unless #defined to be a different length. This default length | 115 * unless #defined to be a different length. This default length |
| 105 * suffices to get rid of MALLOC calls except for unusual cases, | 116 * suffices to get rid of MALLOC calls except for unusual cases, |
| 106 * such as decimal-to-binary conversion of a very long string of | 117 * such as decimal-to-binary conversion of a very long string of |
| 107 * digits. The longest string dtoa can return is about 751 bytes | 118 * digits. The longest string dtoa can return is about 751 bytes |
| 108 * long. For conversions by strtod of strings of 800 digits and | 119 * long. For conversions by strtod of strings of 800 digits and |
| 109 * all dtoa conversions in single-threaded executions with 8-byte | 120 * all dtoa conversions in single-threaded executions with 8-byte |
| 110 * pointers, PRIVATE_MEM >= 7400 appears to suffice; with 4-byte | 121 * pointers, PRIVATE_MEM >= 7400 appears to suffice; with 4-byte |
| 111 * pointers, PRIVATE_MEM >= 7112 appears adequate. | 122 * pointers, PRIVATE_MEM >= 7112 appears adequate. |
| 112 * #define INFNAN_CHECK on IEEE systems to cause strtod to check for | 123 * #define NO_INFNAN_CHECK if you do not wish to have INFNAN_CHECK |
| 113 *» Infinity and NaN (case insensitively). On some systems (e.g., | 124 *» #defined automatically on IEEE systems. On such systems, |
| 114 *» some HP systems), it may be necessary to #define NAN_WORD0 | 125 *» when INFNAN_CHECK is #defined, strtod checks |
| 126 *» for Infinity and NaN (case insensitively). On some systems |
| 127 *» (e.g., some HP systems), it may be necessary to #define NAN_WORD0 |
| 115 * appropriately -- to the most significant word of a quiet NaN. | 128 * appropriately -- to the most significant word of a quiet NaN. |
| 116 * (On HP Series 700/800 machines, -DNAN_WORD0=0x7ff40000 works.) | 129 * (On HP Series 700/800 machines, -DNAN_WORD0=0x7ff40000 works.) |
| 117 * When INFNAN_CHECK is #defined and No_Hex_NaN is not #defined, | 130 * When INFNAN_CHECK is #defined and No_Hex_NaN is not #defined, |
| 118 * strtod also accepts (case insensitively) strings of the form | 131 * strtod also accepts (case insensitively) strings of the form |
| 119 * NaN(x), where x is a string of hexadecimal digits and spaces; | 132 * NaN(x), where x is a string of hexadecimal digits and spaces; |
| 120 * if there is only one string of hexadecimal digits, it is taken | 133 * if there is only one string of hexadecimal digits, it is taken |
| 121 * for the 52 fraction bits of the resulting NaN; if there are two | 134 * for the 52 fraction bits of the resulting NaN; if there are two |
| 122 * or more strings of hex digits, the first is for the high 20 bits, | 135 * or more strings of hex digits, the first is for the high 20 bits, |
| 123 * the second and subsequent for the low 32 bits, with intervening | 136 * the second and subsequent for the low 32 bits, with intervening |
| 124 * white space ignored; but if this results in none of the 52 | 137 * white space ignored; but if this results in none of the 52 |
| 125 * fraction bits being on (an IEEE Infinity symbol), then NAN_WORD0 | 138 * fraction bits being on (an IEEE Infinity symbol), then NAN_WORD0 |
| 126 * and NAN_WORD1 are used instead. | 139 * and NAN_WORD1 are used instead. |
| 127 * #define MULTIPLE_THREADS if the system offers preemptively scheduled | 140 * #define MULTIPLE_THREADS if the system offers preemptively scheduled |
| 128 * multiple threads. In this case, you must provide (or suitably | 141 * multiple threads. In this case, you must provide (or suitably |
| 129 * #define) two locks, acquired by ACQUIRE_DTOA_LOCK(n) and freed | 142 * #define) two locks, acquired by ACQUIRE_DTOA_LOCK(n) and freed |
| 130 * by FREE_DTOA_LOCK(n) for n = 0 or 1. (The second lock, accessed | 143 * by FREE_DTOA_LOCK(n) for n = 0 or 1. (The second lock, accessed |
| 131 * in pow5mult, ensures lazy evaluation of only one copy of high | 144 * in pow5mult, ensures lazy evaluation of only one copy of high |
| 132 * powers of 5; omitting this lock would introduce a small | 145 * powers of 5; omitting this lock would introduce a small |
| 133 * probability of wasting memory, but would otherwise be harmless.) | 146 * probability of wasting memory, but would otherwise be harmless.) |
| 134 * You must also invoke freedtoa(s) to free the value s returned by | 147 * You must also invoke freedtoa(s) to free the value s returned by |
| 135 * dtoa. You may do so whether or not MULTIPLE_THREADS is #defined. | 148 * dtoa. You may do so whether or not MULTIPLE_THREADS is #defined. |
| 136 * #define NO_IEEE_Scale to disable new (Feb. 1997) logic in strtod that | 149 * #define NO_IEEE_Scale to disable new (Feb. 1997) logic in strtod that |
| 137 * avoids underflows on inputs whose result does not underflow. | 150 * avoids underflows on inputs whose result does not underflow. |
| 138 * If you #define NO_IEEE_Scale on a machine that uses IEEE-format | 151 * If you #define NO_IEEE_Scale on a machine that uses IEEE-format |
| 139 * floating-point numbers and flushes underflows to zero rather | 152 * floating-point numbers and flushes underflows to zero rather |
| 140 * than implementing gradual underflow, then you must also #define | 153 * than implementing gradual underflow, then you must also #define |
| 141 * Sudden_Underflow. | 154 * Sudden_Underflow. |
| 142 * #define YES_ALIAS to permit aliasing certain double values with | |
| 143 * arrays of ULongs. This leads to slightly better code with | |
| 144 * some compilers and was always used prior to 19990916, but it | |
| 145 * is not strictly legal and can cause trouble with aggressively | |
| 146 * optimizing compilers (e.g., gcc 2.95.1 under -O2). | |
| 147 * #define USE_LOCALE to use the current locale's decimal_point value. | 155 * #define USE_LOCALE to use the current locale's decimal_point value. |
| 148 * #define SET_INEXACT if IEEE arithmetic is being used and extra | 156 * #define SET_INEXACT if IEEE arithmetic is being used and extra |
| 149 * computation should be done to set the inexact flag when the | 157 * computation should be done to set the inexact flag when the |
| 150 * result is inexact and avoid setting inexact when the result | 158 * result is inexact and avoid setting inexact when the result |
| 151 * is exact. In this case, dtoa.c must be compiled in | 159 * is exact. In this case, dtoa.c must be compiled in |
| 152 * an environment, perhaps provided by #include "dtoa.c" in a | 160 * an environment, perhaps provided by #include "dtoa.c" in a |
| 153 * suitable wrapper, that defines two functions, | 161 * suitable wrapper, that defines two functions, |
| 154 * int get_inexact(void); | 162 * int get_inexact(void); |
| 155 * void clear_inexact(void); | 163 * void clear_inexact(void); |
| 156 * such that get_inexact() returns a nonzero value if the | 164 * such that get_inexact() returns a nonzero value if the |
| 157 * inexact bit is already set, and clear_inexact() sets the | 165 * inexact bit is already set, and clear_inexact() sets the |
| 158 * inexact bit to 0. When SET_INEXACT is #defined, strtod | 166 * inexact bit to 0. When SET_INEXACT is #defined, strtod |
| 159 * also does extra computations to set the underflow and overflow | 167 * also does extra computations to set the underflow and overflow |
| 160 * flags when appropriate (i.e., when the result is tiny and | 168 * flags when appropriate (i.e., when the result is tiny and |
| 161 * inexact or when it is a numeric value rounded to +-infinity). | 169 * inexact or when it is a numeric value rounded to +-infinity). |
| 162 * #define NO_ERRNO if strtod should not assign errno = ERANGE when | 170 * #define NO_ERRNO if strtod should not assign errno = ERANGE when |
| 163 * the result overflows to +-Infinity or underflows to 0. | 171 * the result overflows to +-Infinity or underflows to 0. |
| 172 * #define NO_HEX_FP to omit recognition of hexadecimal floating-point |
| 173 * values by strtod. |
| 174 * #define NO_STRTOD_BIGCOMP (on IEEE-arithmetic systems only for now) |
| 175 * to disable logic for "fast" testing of very long input strings |
| 176 * to strtod. This testing proceeds by initially truncating the |
| 177 * input string, then if necessary comparing the whole string with |
| 178 * a decimal expansion to decide close cases. This logic is only |
| 179 * used for input more than STRTOD_DIGLIM digits long (default 40). |
| 164 */ | 180 */ |
| 165 | 181 |
| 166 #ifndef Long | 182 #ifndef Long |
| 167 #define Long long | 183 #define Long long |
| 168 #endif | 184 #endif |
| 169 #ifndef ULong | 185 #ifndef ULong |
| 170 typedef unsigned Long ULong; | 186 typedef unsigned Long ULong; |
| 171 #endif | 187 #endif |
| 172 | 188 |
| 173 #ifdef DEBUG | 189 #ifdef DEBUG |
| 174 #include "stdio.h" | 190 #include "stdio.h" |
| 175 #define Bug(x) {fprintf(stderr, "%s\n", x); exit(1);} | 191 #define Bug(x) {fprintf(stderr, "%s\n", x); exit(1);} |
| 176 #endif | 192 #endif |
| 177 | 193 |
| 178 #include "stdlib.h" | 194 #include "stdlib.h" |
| 179 #include "string.h" | 195 #include "string.h" |
| 180 | 196 |
| 181 #ifdef USE_LOCALE | 197 #ifdef USE_LOCALE |
| 182 #include "locale.h" | 198 #include "locale.h" |
| 183 #endif | 199 #endif |
| 184 | 200 |
| 201 #ifdef Honor_FLT_ROUNDS |
| 202 #ifndef Trust_FLT_ROUNDS |
| 203 #include <fenv.h> |
| 204 #endif |
| 205 #endif |
| 206 |
| 185 #ifdef MALLOC | 207 #ifdef MALLOC |
| 186 #ifdef KR_headers | 208 #ifdef KR_headers |
| 187 extern char *MALLOC(); | 209 extern char *MALLOC(); |
| 188 #else | 210 #else |
| 189 extern void *MALLOC(size_t); | 211 extern void *MALLOC(size_t); |
| 190 #endif | 212 #endif |
| 191 #else | 213 #else |
| 192 #define MALLOC malloc | 214 #define MALLOC malloc |
| 193 #endif | 215 #endif |
| 194 | 216 |
| 195 #ifndef Omit_Private_Memory | 217 #ifndef Omit_Private_Memory |
| 196 #ifndef PRIVATE_MEM | 218 #ifndef PRIVATE_MEM |
| 197 #define PRIVATE_MEM 2304 | 219 #define PRIVATE_MEM 2304 |
| 198 #endif | 220 #endif |
| 199 #define PRIVATE_mem ((PRIVATE_MEM+sizeof(double)-1)/sizeof(double)) | 221 #define PRIVATE_mem ((PRIVATE_MEM+sizeof(double)-1)/sizeof(double)) |
| 200 static double private_mem[PRIVATE_mem], *pmem_next = private_mem; | 222 static double private_mem[PRIVATE_mem], *pmem_next = private_mem; |
| 201 #endif | 223 #endif |
| 202 | 224 |
| 203 #undef IEEE_Arith | 225 #undef IEEE_Arith |
| 204 #undef Avoid_Underflow | 226 #undef Avoid_Underflow |
| 205 #ifdef IEEE_MC68k | 227 #ifdef IEEE_MC68k |
| 206 #define IEEE_Arith | 228 #define IEEE_Arith |
| 207 #endif | 229 #endif |
| 208 #ifdef IEEE_8087 | 230 #ifdef IEEE_8087 |
| 209 #define IEEE_Arith | 231 #define IEEE_Arith |
| 210 #endif | 232 #endif |
| 211 | 233 |
| 234 #ifdef IEEE_Arith |
| 235 #ifndef NO_INFNAN_CHECK |
| 236 #undef INFNAN_CHECK |
| 237 #define INFNAN_CHECK |
| 238 #endif |
| 239 #else |
| 240 #undef INFNAN_CHECK |
| 241 #define NO_STRTOD_BIGCOMP |
| 242 #endif |
| 243 |
| 212 #include "errno.h" | 244 #include "errno.h" |
| 213 | 245 |
| 214 #ifdef Bad_float_h | 246 #ifdef Bad_float_h |
| 215 | 247 |
| 216 #ifdef IEEE_Arith | 248 #ifdef IEEE_Arith |
| 217 #define DBL_DIG 15 | 249 #define DBL_DIG 15 |
| 218 #define DBL_MAX_10_EXP 308 | 250 #define DBL_MAX_10_EXP 308 |
| 219 #define DBL_MAX_EXP 1024 | 251 #define DBL_MAX_EXP 1024 |
| 220 #define FLT_RADIX 2 | 252 #define FLT_RADIX 2 |
| 221 #endif /*IEEE_Arith*/ | 253 #endif /*IEEE_Arith*/ |
| (...skipping 37 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 259 #define CONST const | 291 #define CONST const |
| 260 #endif | 292 #endif |
| 261 #endif | 293 #endif |
| 262 | 294 |
| 263 #if defined(IEEE_8087) + defined(IEEE_MC68k) + defined(VAX) + defined(IBM) != 1 | 295 #if defined(IEEE_8087) + defined(IEEE_MC68k) + defined(VAX) + defined(IBM) != 1 |
| 264 Exactly one of IEEE_8087, IEEE_MC68k, VAX, or IBM should be defined. | 296 Exactly one of IEEE_8087, IEEE_MC68k, VAX, or IBM should be defined. |
| 265 #endif | 297 #endif |
| 266 | 298 |
| 267 typedef union { double d; ULong L[2]; } U; | 299 typedef union { double d; ULong L[2]; } U; |
| 268 | 300 |
| 269 #ifdef YES_ALIAS | |
| 270 #define dval(x) x | |
| 271 #ifdef IEEE_8087 | 301 #ifdef IEEE_8087 |
| 272 #define word0(x) ((ULong *)&x)[1] | 302 #define word0(x) (x)->L[1] |
| 273 #define word1(x) ((ULong *)&x)[0] | 303 #define word1(x) (x)->L[0] |
| 274 #else | 304 #else |
| 275 #define word0(x) ((ULong *)&x)[0] | 305 #define word0(x) (x)->L[0] |
| 276 #define word1(x) ((ULong *)&x)[1] | 306 #define word1(x) (x)->L[1] |
| 277 #endif | 307 #endif |
| 308 #define dval(x) (x)->d |
| 309 |
| 310 #ifndef STRTOD_DIGLIM |
| 311 #define STRTOD_DIGLIM 40 |
| 312 #endif |
| 313 |
| 314 #ifdef DIGLIM_DEBUG |
| 315 extern int strtod_diglim; |
| 278 #else | 316 #else |
| 279 #ifdef IEEE_8087 | 317 #define strtod_diglim STRTOD_DIGLIM |
| 280 #define word0(x) ((U*)&x)->L[1] | |
| 281 #define word1(x) ((U*)&x)->L[0] | |
| 282 #else | |
| 283 #define word0(x) ((U*)&x)->L[0] | |
| 284 #define word1(x) ((U*)&x)->L[1] | |
| 285 #endif | |
| 286 #define dval(x) ((U*)&x)->d | |
| 287 #endif | 318 #endif |
| 288 | 319 |
| 289 /* The following definition of Storeinc is appropriate for MIPS processors. | 320 /* The following definition of Storeinc is appropriate for MIPS processors. |
| 290 * An alternative that might be better on some machines is | 321 * An alternative that might be better on some machines is |
| 291 * #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff) | 322 * #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff) |
| 292 */ | 323 */ |
| 293 #if defined(IEEE_8087) + defined(VAX) | 324 #if defined(IEEE_8087) + defined(VAX) |
| 294 #define Storeinc(a,b,c) (((unsigned short *)a)[1] = (unsigned short)b, \ | 325 #define Storeinc(a,b,c) (((unsigned short *)a)[1] = (unsigned short)b, \ |
| 295 ((unsigned short *)a)[0] = (unsigned short)c, a++) | 326 ((unsigned short *)a)[0] = (unsigned short)c, a++) |
| 296 #else | 327 #else |
| 297 #define Storeinc(a,b,c) (((unsigned short *)a)[0] = (unsigned short)b, \ | 328 #define Storeinc(a,b,c) (((unsigned short *)a)[0] = (unsigned short)b, \ |
| 298 ((unsigned short *)a)[1] = (unsigned short)c, a++) | 329 ((unsigned short *)a)[1] = (unsigned short)c, a++) |
| 299 #endif | 330 #endif |
| 300 | 331 |
| 301 /* #define P DBL_MANT_DIG */ | 332 /* #define P DBL_MANT_DIG */ |
| 302 /* Ten_pmax = floor(P*log(2)/log(5)) */ | 333 /* Ten_pmax = floor(P*log(2)/log(5)) */ |
| 303 /* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */ | 334 /* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */ |
| 304 /* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */ | 335 /* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */ |
| 305 /* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */ | 336 /* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */ |
| 306 | 337 |
| 307 #ifdef IEEE_Arith | 338 #ifdef IEEE_Arith |
| 308 #define Exp_shift 20 | 339 #define Exp_shift 20 |
| 309 #define Exp_shift1 20 | 340 #define Exp_shift1 20 |
| 310 #define Exp_msk1 0x100000 | 341 #define Exp_msk1 0x100000 |
| 311 #define Exp_msk11 0x100000 | 342 #define Exp_msk11 0x100000 |
| 312 #define Exp_mask 0x7ff00000 | 343 #define Exp_mask 0x7ff00000 |
| 313 #define P 53 | 344 #define P 53 |
| 345 #define Nbits 53 |
| 314 #define Bias 1023 | 346 #define Bias 1023 |
| 347 #define Emax 1023 |
| 315 #define Emin (-1022) | 348 #define Emin (-1022) |
| 316 #define Exp_1 0x3ff00000 | 349 #define Exp_1 0x3ff00000 |
| 317 #define Exp_11 0x3ff00000 | 350 #define Exp_11 0x3ff00000 |
| 318 #define Ebits 11 | 351 #define Ebits 11 |
| 319 #define Frac_mask 0xfffff | 352 #define Frac_mask 0xfffff |
| 320 #define Frac_mask1 0xfffff | 353 #define Frac_mask1 0xfffff |
| 321 #define Ten_pmax 22 | 354 #define Ten_pmax 22 |
| 322 #define Bletch 0x10 | 355 #define Bletch 0x10 |
| 323 #define Bndry_mask 0xfffff | 356 #define Bndry_mask 0xfffff |
| 324 #define Bndry_mask1 0xfffff | 357 #define Bndry_mask1 0xfffff |
| (...skipping 13 matching lines...) Expand all Loading... |
| 338 | 371 |
| 339 #ifndef Flt_Rounds | 372 #ifndef Flt_Rounds |
| 340 #ifdef FLT_ROUNDS | 373 #ifdef FLT_ROUNDS |
| 341 #define Flt_Rounds FLT_ROUNDS | 374 #define Flt_Rounds FLT_ROUNDS |
| 342 #else | 375 #else |
| 343 #define Flt_Rounds 1 | 376 #define Flt_Rounds 1 |
| 344 #endif | 377 #endif |
| 345 #endif /*Flt_Rounds*/ | 378 #endif /*Flt_Rounds*/ |
| 346 | 379 |
| 347 #ifdef Honor_FLT_ROUNDS | 380 #ifdef Honor_FLT_ROUNDS |
| 348 #define Rounding rounding | |
| 349 #undef Check_FLT_ROUNDS | 381 #undef Check_FLT_ROUNDS |
| 350 #define Check_FLT_ROUNDS | 382 #define Check_FLT_ROUNDS |
| 351 #else | 383 #else |
| 352 #define Rounding Flt_Rounds | 384 #define Rounding Flt_Rounds |
| 353 #endif | 385 #endif |
| 354 | 386 |
| 355 #else /* ifndef IEEE_Arith */ | 387 #else /* ifndef IEEE_Arith */ |
| 356 #undef Check_FLT_ROUNDS | 388 #undef Check_FLT_ROUNDS |
| 357 #undef Honor_FLT_ROUNDS | 389 #undef Honor_FLT_ROUNDS |
| 358 #undef SET_INEXACT | 390 #undef SET_INEXACT |
| 359 #undef Sudden_Underflow | 391 #undef Sudden_Underflow |
| 360 #define Sudden_Underflow | 392 #define Sudden_Underflow |
| 361 #ifdef IBM | 393 #ifdef IBM |
| 362 #undef Flt_Rounds | 394 #undef Flt_Rounds |
| 363 #define Flt_Rounds 0 | 395 #define Flt_Rounds 0 |
| 364 #define Exp_shift 24 | 396 #define Exp_shift 24 |
| 365 #define Exp_shift1 24 | 397 #define Exp_shift1 24 |
| 366 #define Exp_msk1 0x1000000 | 398 #define Exp_msk1 0x1000000 |
| 367 #define Exp_msk11 0x1000000 | 399 #define Exp_msk11 0x1000000 |
| 368 #define Exp_mask 0x7f000000 | 400 #define Exp_mask 0x7f000000 |
| 369 #define P 14 | 401 #define P 14 |
| 402 #define Nbits 56 |
| 370 #define Bias 65 | 403 #define Bias 65 |
| 404 #define Emax 248 |
| 405 #define Emin (-260) |
| 371 #define Exp_1 0x41000000 | 406 #define Exp_1 0x41000000 |
| 372 #define Exp_11 0x41000000 | 407 #define Exp_11 0x41000000 |
| 373 #define Ebits 8 /* exponent has 7 bits, but 8 is the right value in b2d */ | 408 #define Ebits 8 /* exponent has 7 bits, but 8 is the right value in b2d */ |
| 374 #define Frac_mask 0xffffff | 409 #define Frac_mask 0xffffff |
| 375 #define Frac_mask1 0xffffff | 410 #define Frac_mask1 0xffffff |
| 376 #define Bletch 4 | 411 #define Bletch 4 |
| 377 #define Ten_pmax 22 | 412 #define Ten_pmax 22 |
| 378 #define Bndry_mask 0xefffff | 413 #define Bndry_mask 0xefffff |
| 379 #define Bndry_mask1 0xffffff | 414 #define Bndry_mask1 0xffffff |
| 380 #define LSB 1 | 415 #define LSB 1 |
| 381 #define Sign_bit 0x80000000 | 416 #define Sign_bit 0x80000000 |
| 382 #define Log2P 4 | 417 #define Log2P 4 |
| 383 #define Tiny0 0x100000 | 418 #define Tiny0 0x100000 |
| 384 #define Tiny1 0 | 419 #define Tiny1 0 |
| 385 #define Quick_max 14 | 420 #define Quick_max 14 |
| 386 #define Int_max 15 | 421 #define Int_max 15 |
| 387 #else /* VAX */ | 422 #else /* VAX */ |
| 388 #undef Flt_Rounds | 423 #undef Flt_Rounds |
| 389 #define Flt_Rounds 1 | 424 #define Flt_Rounds 1 |
| 390 #define Exp_shift 23 | 425 #define Exp_shift 23 |
| 391 #define Exp_shift1 7 | 426 #define Exp_shift1 7 |
| 392 #define Exp_msk1 0x80 | 427 #define Exp_msk1 0x80 |
| 393 #define Exp_msk11 0x800000 | 428 #define Exp_msk11 0x800000 |
| 394 #define Exp_mask 0x7f80 | 429 #define Exp_mask 0x7f80 |
| 395 #define P 56 | 430 #define P 56 |
| 431 #define Nbits 56 |
| 396 #define Bias 129 | 432 #define Bias 129 |
| 433 #define Emax 126 |
| 434 #define Emin (-129) |
| 397 #define Exp_1 0x40800000 | 435 #define Exp_1 0x40800000 |
| 398 #define Exp_11 0x4080 | 436 #define Exp_11 0x4080 |
| 399 #define Ebits 8 | 437 #define Ebits 8 |
| 400 #define Frac_mask 0x7fffff | 438 #define Frac_mask 0x7fffff |
| 401 #define Frac_mask1 0xffff007f | 439 #define Frac_mask1 0xffff007f |
| 402 #define Ten_pmax 24 | 440 #define Ten_pmax 24 |
| 403 #define Bletch 2 | 441 #define Bletch 2 |
| 404 #define Bndry_mask 0xffff007f | 442 #define Bndry_mask 0xffff007f |
| 405 #define Bndry_mask1 0xffff007f | 443 #define Bndry_mask1 0xffff007f |
| 406 #define LSB 0x10000 | 444 #define LSB 0x10000 |
| (...skipping 23 matching lines...) Expand all Loading... |
| 430 #define rounded_quotient(a,b) a /= b | 468 #define rounded_quotient(a,b) a /= b |
| 431 #endif | 469 #endif |
| 432 | 470 |
| 433 #define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1)) | 471 #define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1)) |
| 434 #define Big1 0xffffffff | 472 #define Big1 0xffffffff |
| 435 | 473 |
| 436 #ifndef Pack_32 | 474 #ifndef Pack_32 |
| 437 #define Pack_32 | 475 #define Pack_32 |
| 438 #endif | 476 #endif |
| 439 | 477 |
| 478 typedef struct BCinfo BCinfo; |
| 479 struct |
| 480 BCinfo { int dp0, dp1, dplen, dsign, e0, inexact, nd, nd0, rounding, scale, uflc
hk; }; |
| 481 |
| 440 #ifdef KR_headers | 482 #ifdef KR_headers |
| 441 #define FFFFFFFF ((((unsigned long)0xffff)<<16)|(unsigned long)0xffff) | 483 #define FFFFFFFF ((((unsigned long)0xffff)<<16)|(unsigned long)0xffff) |
| 442 #else | 484 #else |
| 443 #define FFFFFFFF 0xffffffffUL | 485 #define FFFFFFFF 0xffffffffUL |
| 444 #endif | 486 #endif |
| 445 | 487 |
| 446 #ifdef NO_LONG_LONG | 488 #ifdef NO_LONG_LONG |
| 447 #undef ULLong | 489 #undef ULLong |
| 448 #ifdef Just_16 | 490 #ifdef Just_16 |
| 449 #undef Pack_32 | 491 #undef Pack_32 |
| (...skipping 10 matching lines...) Expand all Loading... |
| 460 #ifndef ULLong | 502 #ifndef ULLong |
| 461 #define ULLong unsigned Llong | 503 #define ULLong unsigned Llong |
| 462 #endif | 504 #endif |
| 463 #endif /* NO_LONG_LONG */ | 505 #endif /* NO_LONG_LONG */ |
| 464 | 506 |
| 465 #ifndef MULTIPLE_THREADS | 507 #ifndef MULTIPLE_THREADS |
| 466 #define ACQUIRE_DTOA_LOCK(n) /*nothing*/ | 508 #define ACQUIRE_DTOA_LOCK(n) /*nothing*/ |
| 467 #define FREE_DTOA_LOCK(n) /*nothing*/ | 509 #define FREE_DTOA_LOCK(n) /*nothing*/ |
| 468 #endif | 510 #endif |
| 469 | 511 |
| 470 #define Kmax 15 | 512 #define Kmax 7 |
| 471 | 513 |
| 472 #ifdef __cplusplus | 514 #ifdef __cplusplus |
| 473 extern "C" double strtod(const char *s00, char **se); | 515 extern "C" double strtod(const char *s00, char **se); |
| 474 extern "C" char *dtoa(double d, int mode, int ndigits, | 516 extern "C" char *dtoa(double d, int mode, int ndigits, |
| 475 int *decpt, int *sign, char **rve); | 517 int *decpt, int *sign, char **rve); |
| 476 #endif | 518 #endif |
| 477 | 519 |
| 478 struct | 520 struct |
| 479 Bigint { | 521 Bigint { |
| 480 struct Bigint *next; | 522 struct Bigint *next; |
| (...skipping 13 matching lines...) Expand all Loading... |
| 494 (int k) | 536 (int k) |
| 495 #endif | 537 #endif |
| 496 { | 538 { |
| 497 int x; | 539 int x; |
| 498 Bigint *rv; | 540 Bigint *rv; |
| 499 #ifndef Omit_Private_Memory | 541 #ifndef Omit_Private_Memory |
| 500 unsigned int len; | 542 unsigned int len; |
| 501 #endif | 543 #endif |
| 502 | 544 |
| 503 ACQUIRE_DTOA_LOCK(0); | 545 ACQUIRE_DTOA_LOCK(0); |
| 504 » if ((rv = freelist[k])) { | 546 » /* The k > Kmax case does not need ACQUIRE_DTOA_LOCK(0), */ |
| 547 » /* but this case seems very unlikely. */ |
| 548 » if (k <= Kmax && (rv = freelist[k])) |
| 505 freelist[k] = rv->next; | 549 freelist[k] = rv->next; |
| 506 } | |
| 507 else { | 550 else { |
| 508 x = 1 << k; | 551 x = 1 << k; |
| 509 #ifdef Omit_Private_Memory | 552 #ifdef Omit_Private_Memory |
| 510 rv = (Bigint *)MALLOC(sizeof(Bigint) + (x-1)*sizeof(ULong)); | 553 rv = (Bigint *)MALLOC(sizeof(Bigint) + (x-1)*sizeof(ULong)); |
| 511 #else | 554 #else |
| 512 len = (sizeof(Bigint) + (x-1)*sizeof(ULong) + sizeof(double) - 1
) | 555 len = (sizeof(Bigint) + (x-1)*sizeof(ULong) + sizeof(double) - 1
) |
| 513 /sizeof(double); | 556 /sizeof(double); |
| 514 » » if (pmem_next - private_mem + len <= PRIVATE_mem) { | 557 » » if (k <= Kmax && pmem_next - private_mem + len <= PRIVATE_mem) { |
| 515 rv = (Bigint*)pmem_next; | 558 rv = (Bigint*)pmem_next; |
| 516 pmem_next += len; | 559 pmem_next += len; |
| 517 } | 560 } |
| 518 else | 561 else |
| 519 rv = (Bigint*)MALLOC(len*sizeof(double)); | 562 rv = (Bigint*)MALLOC(len*sizeof(double)); |
| 520 #endif | 563 #endif |
| 521 rv->k = k; | 564 rv->k = k; |
| 522 rv->maxwds = x; | 565 rv->maxwds = x; |
| 523 } | 566 } |
| 524 FREE_DTOA_LOCK(0); | 567 FREE_DTOA_LOCK(0); |
| 525 rv->sign = rv->wds = 0; | 568 rv->sign = rv->wds = 0; |
| 526 return rv; | 569 return rv; |
| 527 } | 570 } |
| 528 | 571 |
| 529 static void | 572 static void |
| 530 Bfree | 573 Bfree |
| 531 #ifdef KR_headers | 574 #ifdef KR_headers |
| 532 (v) Bigint *v; | 575 (v) Bigint *v; |
| 533 #else | 576 #else |
| 534 (Bigint *v) | 577 (Bigint *v) |
| 535 #endif | 578 #endif |
| 536 { | 579 { |
| 537 if (v) { | 580 if (v) { |
| 538 » » ACQUIRE_DTOA_LOCK(0); | 581 » » if (v->k > Kmax) |
| 539 » » v->next = freelist[v->k]; | 582 #ifdef FREE |
| 540 » » freelist[v->k] = v; | 583 » » » FREE((void*)v); |
| 541 » » FREE_DTOA_LOCK(0); | 584 #else |
| 585 » » » free((void*)v); |
| 586 #endif |
| 587 » » else { |
| 588 » » » ACQUIRE_DTOA_LOCK(0); |
| 589 » » » v->next = freelist[v->k]; |
| 590 » » » freelist[v->k] = v; |
| 591 » » » FREE_DTOA_LOCK(0); |
| 592 » » » } |
| 542 } | 593 } |
| 543 } | 594 } |
| 544 | 595 |
| 545 #define Bcopy(x,y) memcpy((char *)&x->sign, (char *)&y->sign, \ | 596 #define Bcopy(x,y) memcpy((char *)&x->sign, (char *)&y->sign, \ |
| 546 y->wds*sizeof(Long) + 2*sizeof(int)) | 597 y->wds*sizeof(Long) + 2*sizeof(int)) |
| 547 | 598 |
| 548 static Bigint * | 599 static Bigint * |
| 549 multadd | 600 multadd |
| 550 #ifdef KR_headers | 601 #ifdef KR_headers |
| 551 (b, m, a) Bigint *b; int m, a; | 602 (b, m, a) Bigint *b; int m, a; |
| (...skipping 46 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 598 } | 649 } |
| 599 b->x[wds++] = carry; | 650 b->x[wds++] = carry; |
| 600 b->wds = wds; | 651 b->wds = wds; |
| 601 } | 652 } |
| 602 return b; | 653 return b; |
| 603 } | 654 } |
| 604 | 655 |
| 605 static Bigint * | 656 static Bigint * |
| 606 s2b | 657 s2b |
| 607 #ifdef KR_headers | 658 #ifdef KR_headers |
| 608 » (s, nd0, nd, y9) CONST char *s; int nd0, nd; ULong y9; | 659 » (s, nd0, nd, y9, dplen) CONST char *s; int nd0, nd, dplen; ULong y9; |
| 609 #else | 660 #else |
| 610 » (CONST char *s, int nd0, int nd, ULong y9) | 661 » (CONST char *s, int nd0, int nd, ULong y9, int dplen) |
| 611 #endif | 662 #endif |
| 612 { | 663 { |
| 613 Bigint *b; | 664 Bigint *b; |
| 614 int i, k; | 665 int i, k; |
| 615 Long x, y; | 666 Long x, y; |
| 616 | 667 |
| 617 x = (nd + 8) / 9; | 668 x = (nd + 8) / 9; |
| 618 for(k = 0, y = 1; x > y; y <<= 1, k++) ; | 669 for(k = 0, y = 1; x > y; y <<= 1, k++) ; |
| 619 #ifdef Pack_32 | 670 #ifdef Pack_32 |
| 620 b = Balloc(k); | 671 b = Balloc(k); |
| 621 b->x[0] = y9; | 672 b->x[0] = y9; |
| 622 b->wds = 1; | 673 b->wds = 1; |
| 623 #else | 674 #else |
| 624 b = Balloc(k+1); | 675 b = Balloc(k+1); |
| 625 b->x[0] = y9 & 0xffff; | 676 b->x[0] = y9 & 0xffff; |
| 626 b->wds = (b->x[1] = y9 >> 16) ? 2 : 1; | 677 b->wds = (b->x[1] = y9 >> 16) ? 2 : 1; |
| 627 #endif | 678 #endif |
| 628 | 679 |
| 629 i = 9; | 680 i = 9; |
| 630 if (9 < nd0) { | 681 if (9 < nd0) { |
| 631 s += 9; | 682 s += 9; |
| 632 do b = multadd(b, 10, *s++ - '0'); | 683 do b = multadd(b, 10, *s++ - '0'); |
| 633 while(++i < nd0); | 684 while(++i < nd0); |
| 634 » » s++; | 685 » » s += dplen; |
| 635 } | 686 } |
| 636 else | 687 else |
| 637 » » s += 10; | 688 » » s += dplen + 9; |
| 638 for(; i < nd; i++) | 689 for(; i < nd; i++) |
| 639 b = multadd(b, 10, *s++ - '0'); | 690 b = multadd(b, 10, *s++ - '0'); |
| 640 return b; | 691 return b; |
| 641 } | 692 } |
| 642 | 693 |
| 643 static int | 694 static int |
| 644 hi0bits | 695 hi0bits |
| 645 #ifdef KR_headers | 696 #ifdef KR_headers |
| 646 » (x) register ULong x; | 697 » (x) ULong x; |
| 647 #else | 698 #else |
| 648 » (register ULong x) | 699 » (ULong x) |
| 649 #endif | 700 #endif |
| 650 { | 701 { |
| 651 » register int k = 0; | 702 » int k = 0; |
| 652 | 703 |
| 653 if (!(x & 0xffff0000)) { | 704 if (!(x & 0xffff0000)) { |
| 654 k = 16; | 705 k = 16; |
| 655 x <<= 16; | 706 x <<= 16; |
| 656 } | 707 } |
| 657 if (!(x & 0xff000000)) { | 708 if (!(x & 0xff000000)) { |
| 658 k += 8; | 709 k += 8; |
| 659 x <<= 8; | 710 x <<= 8; |
| 660 } | 711 } |
| 661 if (!(x & 0xf0000000)) { | 712 if (!(x & 0xf0000000)) { |
| (...skipping 13 matching lines...) Expand all Loading... |
| 675 } | 726 } |
| 676 | 727 |
| 677 static int | 728 static int |
| 678 lo0bits | 729 lo0bits |
| 679 #ifdef KR_headers | 730 #ifdef KR_headers |
| 680 (y) ULong *y; | 731 (y) ULong *y; |
| 681 #else | 732 #else |
| 682 (ULong *y) | 733 (ULong *y) |
| 683 #endif | 734 #endif |
| 684 { | 735 { |
| 685 » register int k; | 736 » int k; |
| 686 » register ULong x = *y; | 737 » ULong x = *y; |
| 687 | 738 |
| 688 if (x & 7) { | 739 if (x & 7) { |
| 689 if (x & 1) | 740 if (x & 1) |
| 690 return 0; | 741 return 0; |
| 691 if (x & 2) { | 742 if (x & 2) { |
| 692 *y = x >> 1; | 743 *y = x >> 1; |
| 693 return 1; | 744 return 1; |
| 694 } | 745 } |
| 695 *y = x >> 2; | 746 *y = x >> 2; |
| 696 return 2; | 747 return 2; |
| (...skipping 394 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 1091 #endif | 1142 #endif |
| 1092 while(!*--xc) | 1143 while(!*--xc) |
| 1093 wa--; | 1144 wa--; |
| 1094 c->wds = wa; | 1145 c->wds = wa; |
| 1095 return c; | 1146 return c; |
| 1096 } | 1147 } |
| 1097 | 1148 |
| 1098 static double | 1149 static double |
| 1099 ulp | 1150 ulp |
| 1100 #ifdef KR_headers | 1151 #ifdef KR_headers |
| 1101 » (x) double x; | 1152 » (x) U *x; |
| 1102 #else | 1153 #else |
| 1103 » (double x) | 1154 » (U *x) |
| 1104 #endif | 1155 #endif |
| 1105 { | 1156 { |
| 1106 » register Long L; | 1157 » Long L; |
| 1107 » double a; | 1158 » U u; |
| 1108 | 1159 |
| 1109 L = (word0(x) & Exp_mask) - (P-1)*Exp_msk1; | 1160 L = (word0(x) & Exp_mask) - (P-1)*Exp_msk1; |
| 1110 #ifndef Avoid_Underflow | 1161 #ifndef Avoid_Underflow |
| 1111 #ifndef Sudden_Underflow | 1162 #ifndef Sudden_Underflow |
| 1112 if (L > 0) { | 1163 if (L > 0) { |
| 1113 #endif | 1164 #endif |
| 1114 #endif | 1165 #endif |
| 1115 #ifdef IBM | 1166 #ifdef IBM |
| 1116 L |= Exp_msk1 >> 4; | 1167 L |= Exp_msk1 >> 4; |
| 1117 #endif | 1168 #endif |
| 1118 » » word0(a) = L; | 1169 » » word0(&u) = L; |
| 1119 » » word1(a) = 0; | 1170 » » word1(&u) = 0; |
| 1120 #ifndef Avoid_Underflow | 1171 #ifndef Avoid_Underflow |
| 1121 #ifndef Sudden_Underflow | 1172 #ifndef Sudden_Underflow |
| 1122 } | 1173 } |
| 1123 else { | 1174 else { |
| 1124 L = -L >> Exp_shift; | 1175 L = -L >> Exp_shift; |
| 1125 if (L < Exp_shift) { | 1176 if (L < Exp_shift) { |
| 1126 » » » word0(a) = 0x80000 >> L; | 1177 » » » word0(&u) = 0x80000 >> L; |
| 1127 » » » word1(a) = 0; | 1178 » » » word1(&u) = 0; |
| 1128 } | 1179 } |
| 1129 else { | 1180 else { |
| 1130 » » » word0(a) = 0; | 1181 » » » word0(&u) = 0; |
| 1131 L -= Exp_shift; | 1182 L -= Exp_shift; |
| 1132 » » » word1(a) = L >= 31 ? 1 : 1 << 31 - L; | 1183 » » » word1(&u) = L >= 31 ? 1 : 1 << 31 - L; |
| 1133 } | 1184 } |
| 1134 } | 1185 } |
| 1135 #endif | 1186 #endif |
| 1136 #endif | 1187 #endif |
| 1137 » return dval(a); | 1188 » return dval(&u); |
| 1138 } | 1189 } |
| 1139 | 1190 |
| 1140 static double | 1191 static double |
| 1141 b2d | 1192 b2d |
| 1142 #ifdef KR_headers | 1193 #ifdef KR_headers |
| 1143 (a, e) Bigint *a; int *e; | 1194 (a, e) Bigint *a; int *e; |
| 1144 #else | 1195 #else |
| 1145 (Bigint *a, int *e) | 1196 (Bigint *a, int *e) |
| 1146 #endif | 1197 #endif |
| 1147 { | 1198 { |
| 1148 ULong *xa, *xa0, w, y, z; | 1199 ULong *xa, *xa0, w, y, z; |
| 1149 int k; | 1200 int k; |
| 1150 » double d; | 1201 » U d; |
| 1151 #ifdef VAX | 1202 #ifdef VAX |
| 1152 ULong d0, d1; | 1203 ULong d0, d1; |
| 1153 #else | 1204 #else |
| 1154 #define d0 word0(d) | 1205 #define d0 word0(&d) |
| 1155 #define d1 word1(d) | 1206 #define d1 word1(&d) |
| 1156 #endif | 1207 #endif |
| 1157 | 1208 |
| 1158 xa0 = a->x; | 1209 xa0 = a->x; |
| 1159 xa = xa0 + a->wds; | 1210 xa = xa0 + a->wds; |
| 1160 y = *--xa; | 1211 y = *--xa; |
| 1161 #ifdef DEBUG | 1212 #ifdef DEBUG |
| 1162 if (!y) Bug("zero y in b2d"); | 1213 if (!y) Bug("zero y in b2d"); |
| 1163 #endif | 1214 #endif |
| 1164 k = hi0bits(y); | 1215 k = hi0bits(y); |
| 1165 *e = 32 - k; | 1216 *e = 32 - k; |
| (...skipping 25 matching lines...) Expand all Loading... |
| 1191 } | 1242 } |
| 1192 z = xa > xa0 ? *--xa : 0; | 1243 z = xa > xa0 ? *--xa : 0; |
| 1193 w = xa > xa0 ? *--xa : 0; | 1244 w = xa > xa0 ? *--xa : 0; |
| 1194 k -= Ebits + 16; | 1245 k -= Ebits + 16; |
| 1195 d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k; | 1246 d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k; |
| 1196 y = xa > xa0 ? *--xa : 0; | 1247 y = xa > xa0 ? *--xa : 0; |
| 1197 d1 = w << k + 16 | y << k; | 1248 d1 = w << k + 16 | y << k; |
| 1198 #endif | 1249 #endif |
| 1199 ret_d: | 1250 ret_d: |
| 1200 #ifdef VAX | 1251 #ifdef VAX |
| 1201 » word0(d) = d0 >> 16 | d0 << 16; | 1252 » word0(&d) = d0 >> 16 | d0 << 16; |
| 1202 » word1(d) = d1 >> 16 | d1 << 16; | 1253 » word1(&d) = d1 >> 16 | d1 << 16; |
| 1203 #else | 1254 #else |
| 1204 #undef d0 | 1255 #undef d0 |
| 1205 #undef d1 | 1256 #undef d1 |
| 1206 #endif | 1257 #endif |
| 1207 » return dval(d); | 1258 » return dval(&d); |
| 1208 } | 1259 } |
| 1209 | 1260 |
| 1210 static Bigint * | 1261 static Bigint * |
| 1211 d2b | 1262 d2b |
| 1212 #ifdef KR_headers | 1263 #ifdef KR_headers |
| 1213 » (d, e, bits) double d; int *e, *bits; | 1264 » (d, e, bits) U *d; int *e, *bits; |
| 1214 #else | 1265 #else |
| 1215 » (double d, int *e, int *bits) | 1266 » (U *d, int *e, int *bits) |
| 1216 #endif | 1267 #endif |
| 1217 { | 1268 { |
| 1218 Bigint *b; | 1269 Bigint *b; |
| 1219 int de, k; | 1270 int de, k; |
| 1220 ULong *x, y, z; | 1271 ULong *x, y, z; |
| 1221 #ifndef Sudden_Underflow | 1272 #ifndef Sudden_Underflow |
| 1222 int i; | 1273 int i; |
| 1223 #endif | 1274 #endif |
| 1224 #ifdef VAX | 1275 #ifdef VAX |
| 1225 ULong d0, d1; | 1276 ULong d0, d1; |
| (...skipping 29 matching lines...) Expand all Loading... |
| 1255 z >>= k; | 1306 z >>= k; |
| 1256 } | 1307 } |
| 1257 else | 1308 else |
| 1258 x[0] = y; | 1309 x[0] = y; |
| 1259 #ifndef Sudden_Underflow | 1310 #ifndef Sudden_Underflow |
| 1260 i = | 1311 i = |
| 1261 #endif | 1312 #endif |
| 1262 b->wds = (x[1] = z) ? 2 : 1; | 1313 b->wds = (x[1] = z) ? 2 : 1; |
| 1263 } | 1314 } |
| 1264 else { | 1315 else { |
| 1265 /* This assertion fails for "1e-500" and other very | |
| 1266 * small numbers. It provides the right result (0) | |
| 1267 * though. This assert has also been removed from KJS's | |
| 1268 * version of dtoa.c. | |
| 1269 * | |
| 1270 * #ifdef DEBUG | |
| 1271 * if (!z) Bug("zero z in b2d"); | |
| 1272 * #endif | |
| 1273 */ | |
| 1274 k = lo0bits(&z); | 1316 k = lo0bits(&z); |
| 1275 x[0] = z; | 1317 x[0] = z; |
| 1276 #ifndef Sudden_Underflow | 1318 #ifndef Sudden_Underflow |
| 1277 i = | 1319 i = |
| 1278 #endif | 1320 #endif |
| 1279 b->wds = 1; | 1321 b->wds = 1; |
| 1280 k += 32; | 1322 k += 32; |
| 1281 } | 1323 } |
| 1282 #else | 1324 #else |
| 1283 if (y = d1) { | 1325 if (y = d1) { |
| (...skipping 67 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 1351 #undef d1 | 1393 #undef d1 |
| 1352 | 1394 |
| 1353 static double | 1395 static double |
| 1354 ratio | 1396 ratio |
| 1355 #ifdef KR_headers | 1397 #ifdef KR_headers |
| 1356 (a, b) Bigint *a, *b; | 1398 (a, b) Bigint *a, *b; |
| 1357 #else | 1399 #else |
| 1358 (Bigint *a, Bigint *b) | 1400 (Bigint *a, Bigint *b) |
| 1359 #endif | 1401 #endif |
| 1360 { | 1402 { |
| 1361 » double da, db; | 1403 » U da, db; |
| 1362 int k, ka, kb; | 1404 int k, ka, kb; |
| 1363 | 1405 |
| 1364 » dval(da) = b2d(a, &ka); | 1406 » dval(&da) = b2d(a, &ka); |
| 1365 » dval(db) = b2d(b, &kb); | 1407 » dval(&db) = b2d(b, &kb); |
| 1366 #ifdef Pack_32 | 1408 #ifdef Pack_32 |
| 1367 k = ka - kb + 32*(a->wds - b->wds); | 1409 k = ka - kb + 32*(a->wds - b->wds); |
| 1368 #else | 1410 #else |
| 1369 k = ka - kb + 16*(a->wds - b->wds); | 1411 k = ka - kb + 16*(a->wds - b->wds); |
| 1370 #endif | 1412 #endif |
| 1371 #ifdef IBM | 1413 #ifdef IBM |
| 1372 if (k > 0) { | 1414 if (k > 0) { |
| 1373 » » word0(da) += (k >> 2)*Exp_msk1; | 1415 » » word0(&da) += (k >> 2)*Exp_msk1; |
| 1374 if (k &= 3) | 1416 if (k &= 3) |
| 1375 » » » dval(da) *= 1 << k; | 1417 » » » dval(&da) *= 1 << k; |
| 1376 } | 1418 } |
| 1377 else { | 1419 else { |
| 1378 k = -k; | 1420 k = -k; |
| 1379 » » word0(db) += (k >> 2)*Exp_msk1; | 1421 » » word0(&db) += (k >> 2)*Exp_msk1; |
| 1380 if (k &= 3) | 1422 if (k &= 3) |
| 1381 » » » dval(db) *= 1 << k; | 1423 » » » dval(&db) *= 1 << k; |
| 1382 } | 1424 } |
| 1383 #else | 1425 #else |
| 1384 if (k > 0) | 1426 if (k > 0) |
| 1385 » » word0(da) += k*Exp_msk1; | 1427 » » word0(&da) += k*Exp_msk1; |
| 1386 else { | 1428 else { |
| 1387 k = -k; | 1429 k = -k; |
| 1388 » » word0(db) += k*Exp_msk1; | 1430 » » word0(&db) += k*Exp_msk1; |
| 1389 } | 1431 } |
| 1390 #endif | 1432 #endif |
| 1391 » return dval(da) / dval(db); | 1433 » return dval(&da) / dval(&db); |
| 1392 } | 1434 } |
| 1393 | 1435 |
| 1394 static CONST double | 1436 static CONST double |
| 1395 tens[] = { | 1437 tens[] = { |
| 1396 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9, | 1438 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9, |
| 1397 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, | 1439 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, |
| 1398 1e20, 1e21, 1e22 | 1440 1e20, 1e21, 1e22 |
| 1399 #ifdef VAX | 1441 #ifdef VAX |
| 1400 , 1e23, 1e24 | 1442 , 1e23, 1e24 |
| 1401 #endif | 1443 #endif |
| 1402 }; | 1444 }; |
| 1403 | 1445 |
| 1404 static CONST double | 1446 static CONST double |
| 1405 #ifdef IEEE_Arith | 1447 #ifdef IEEE_Arith |
| 1406 bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 }; | 1448 bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 }; |
| 1407 static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128, | 1449 static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128, |
| 1408 #ifdef Avoid_Underflow | 1450 #ifdef Avoid_Underflow |
| 1409 9007199254740992.*9007199254740992.e-256 | 1451 9007199254740992.*9007199254740992.e-256 |
| 1410 » » /* = 2^106 * 1e-53 */ | 1452 » » /* = 2^106 * 1e-256 */ |
| 1411 #else | 1453 #else |
| 1412 1e-256 | 1454 1e-256 |
| 1413 #endif | 1455 #endif |
| 1414 }; | 1456 }; |
| 1415 /* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */ | 1457 /* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */ |
| 1416 /* flag unnecessarily. It leads to a song and dance at the end of strtod. */ | 1458 /* flag unnecessarily. It leads to a song and dance at the end of strtod. */ |
| 1417 #define Scale_Bit 0x10 | 1459 #define Scale_Bit 0x10 |
| 1418 #define n_bigtens 5 | 1460 #define n_bigtens 5 |
| 1419 #else | 1461 #else |
| 1420 #ifdef IBM | 1462 #ifdef IBM |
| 1421 bigtens[] = { 1e16, 1e32, 1e64 }; | 1463 bigtens[] = { 1e16, 1e32, 1e64 }; |
| 1422 static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64 }; | 1464 static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64 }; |
| 1423 #define n_bigtens 3 | 1465 #define n_bigtens 3 |
| 1424 #else | 1466 #else |
| 1425 bigtens[] = { 1e16, 1e32 }; | 1467 bigtens[] = { 1e16, 1e32 }; |
| 1426 static CONST double tinytens[] = { 1e-16, 1e-32 }; | 1468 static CONST double tinytens[] = { 1e-16, 1e-32 }; |
| 1427 #define n_bigtens 2 | 1469 #define n_bigtens 2 |
| 1428 #endif | 1470 #endif |
| 1429 #endif | 1471 #endif |
| 1430 | 1472 |
| 1431 #ifndef IEEE_Arith | 1473 #undef Need_Hexdig |
| 1432 #undef INFNAN_CHECK | 1474 #ifdef INFNAN_CHECK |
| 1475 #ifndef No_Hex_NaN |
| 1476 #define Need_Hexdig |
| 1433 #endif | 1477 #endif |
| 1478 #endif |
| 1479 |
| 1480 #ifndef Need_Hexdig |
| 1481 #ifndef NO_HEX_FP |
| 1482 #define Need_Hexdig |
| 1483 #endif |
| 1484 #endif |
| 1485 |
| 1486 #ifdef Need_Hexdig /*{*/ |
| 1487 static unsigned char hexdig[256]; |
| 1488 |
| 1489 static void |
| 1490 #ifdef KR_headers |
| 1491 htinit(h, s, inc) unsigned char *h; unsigned char *s; int inc; |
| 1492 #else |
| 1493 htinit(unsigned char *h, unsigned char *s, int inc) |
| 1494 #endif |
| 1495 { |
| 1496 int i, j; |
| 1497 for(i = 0; (j = s[i]) !=0; i++) |
| 1498 h[j] = i + inc; |
| 1499 } |
| 1500 |
| 1501 static void |
| 1502 #ifdef KR_headers |
| 1503 hexdig_init() |
| 1504 #else |
| 1505 hexdig_init(void) |
| 1506 #endif |
| 1507 { |
| 1508 #define USC (unsigned char *) |
| 1509 htinit(hexdig, USC "0123456789", 0x10); |
| 1510 htinit(hexdig, USC "abcdef", 0x10 + 10); |
| 1511 htinit(hexdig, USC "ABCDEF", 0x10 + 10); |
| 1512 } |
| 1513 #endif /* } Need_Hexdig */ |
| 1434 | 1514 |
| 1435 #ifdef INFNAN_CHECK | 1515 #ifdef INFNAN_CHECK |
| 1436 | 1516 |
| 1437 #ifndef NAN_WORD0 | 1517 #ifndef NAN_WORD0 |
| 1438 #define NAN_WORD0 0x7ff80000 | 1518 #define NAN_WORD0 0x7ff80000 |
| 1439 #endif | 1519 #endif |
| 1440 | 1520 |
| 1441 #ifndef NAN_WORD1 | 1521 #ifndef NAN_WORD1 |
| 1442 #define NAN_WORD1 0 | 1522 #define NAN_WORD1 0 |
| 1443 #endif | 1523 #endif |
| 1444 | 1524 |
| 1445 static int | 1525 static int |
| 1446 match | 1526 match |
| 1447 #ifdef KR_headers | 1527 #ifdef KR_headers |
| 1448 (sp, t) char **sp, *t; | 1528 (sp, t) char **sp, *t; |
| 1449 #else | 1529 #else |
| 1450 » (CONST char **sp, char *t) | 1530 » (CONST char **sp, CONST char *t) |
| 1451 #endif | 1531 #endif |
| 1452 { | 1532 { |
| 1453 int c, d; | 1533 int c, d; |
| 1454 CONST char *s = *sp; | 1534 CONST char *s = *sp; |
| 1455 | 1535 |
| 1456 » while(d = *t++) { | 1536 » while((d = *t++)) { |
| 1457 if ((c = *++s) >= 'A' && c <= 'Z') | 1537 if ((c = *++s) >= 'A' && c <= 'Z') |
| 1458 c += 'a' - 'A'; | 1538 c += 'a' - 'A'; |
| 1459 if (c != d) | 1539 if (c != d) |
| 1460 return 0; | 1540 return 0; |
| 1461 } | 1541 } |
| 1462 *sp = s + 1; | 1542 *sp = s + 1; |
| 1463 return 1; | 1543 return 1; |
| 1464 } | 1544 } |
| 1465 | 1545 |
| 1466 #ifndef No_Hex_NaN | 1546 #ifndef No_Hex_NaN |
| 1467 static void | 1547 static void |
| 1468 hexnan | 1548 hexnan |
| 1469 #ifdef KR_headers | 1549 #ifdef KR_headers |
| 1470 » (rvp, sp) double *rvp; CONST char **sp; | 1550 » (rvp, sp) U *rvp; CONST char **sp; |
| 1471 #else | 1551 #else |
| 1472 » (double *rvp, CONST char **sp) | 1552 » (U *rvp, CONST char **sp) |
| 1473 #endif | 1553 #endif |
| 1474 { | 1554 { |
| 1475 ULong c, x[2]; | 1555 ULong c, x[2]; |
| 1476 CONST char *s; | 1556 CONST char *s; |
| 1477 » int havedig, udx0, xshift; | 1557 » int c1, havedig, udx0, xshift; |
| 1478 | 1558 |
| 1559 if (!hexdig['0']) |
| 1560 hexdig_init(); |
| 1479 x[0] = x[1] = 0; | 1561 x[0] = x[1] = 0; |
| 1480 havedig = xshift = 0; | 1562 havedig = xshift = 0; |
| 1481 udx0 = 1; | 1563 udx0 = 1; |
| 1482 s = *sp; | 1564 s = *sp; |
| 1483 » while(c = *(CONST unsigned char*)++s) { | 1565 » /* allow optional initial 0x or 0X */ |
| 1484 » » if (c >= '0' && c <= '9') | 1566 » while((c = *(CONST unsigned char*)(s+1)) && c <= ' ') |
| 1485 » » » c -= '0'; | 1567 » » ++s; |
| 1486 » » else if (c >= 'a' && c <= 'f') | 1568 » if (s[1] == '0' && (s[2] == 'x' || s[2] == 'X')) |
| 1487 » » » c += 10 - 'a'; | 1569 » » s += 2; |
| 1488 » » else if (c >= 'A' && c <= 'F') | 1570 » while((c = *(CONST unsigned char*)++s)) { |
| 1489 » » » c += 10 - 'A'; | 1571 » » if ((c1 = hexdig[c])) |
| 1572 » » » c = c1 & 0xf; |
| 1490 else if (c <= ' ') { | 1573 else if (c <= ' ') { |
| 1491 if (udx0 && havedig) { | 1574 if (udx0 && havedig) { |
| 1492 udx0 = 0; | 1575 udx0 = 0; |
| 1493 xshift = 1; | 1576 xshift = 1; |
| 1494 } | 1577 } |
| 1495 continue; | 1578 continue; |
| 1496 } | 1579 } |
| 1580 #ifdef GDTOA_NON_PEDANTIC_NANCHECK |
| 1497 else if (/*(*/ c == ')' && havedig) { | 1581 else if (/*(*/ c == ')' && havedig) { |
| 1498 *sp = s + 1; | 1582 *sp = s + 1; |
| 1499 break; | 1583 break; |
| 1500 } | 1584 } |
| 1501 else | 1585 else |
| 1502 return; /* invalid form: don't change *sp */ | 1586 return; /* invalid form: don't change *sp */ |
| 1587 #else |
| 1588 else { |
| 1589 do { |
| 1590 if (/*(*/ c == ')') { |
| 1591 *sp = s + 1; |
| 1592 break; |
| 1593 } |
| 1594 } while((c = *++s)); |
| 1595 break; |
| 1596 } |
| 1597 #endif |
| 1503 havedig = 1; | 1598 havedig = 1; |
| 1504 if (xshift) { | 1599 if (xshift) { |
| 1505 xshift = 0; | 1600 xshift = 0; |
| 1506 x[0] = x[1]; | 1601 x[0] = x[1]; |
| 1507 x[1] = 0; | 1602 x[1] = 0; |
| 1508 } | 1603 } |
| 1509 if (udx0) | 1604 if (udx0) |
| 1510 x[0] = (x[0] << 4) | (x[1] >> 28); | 1605 x[0] = (x[0] << 4) | (x[1] >> 28); |
| 1511 x[1] = (x[1] << 4) | c; | 1606 x[1] = (x[1] << 4) | c; |
| 1512 } | 1607 } |
| 1513 if ((x[0] &= 0xfffff) || x[1]) { | 1608 if ((x[0] &= 0xfffff) || x[1]) { |
| 1514 » » word0(*rvp) = Exp_mask | x[0]; | 1609 » » word0(rvp) = Exp_mask | x[0]; |
| 1515 » » word1(*rvp) = x[1]; | 1610 » » word1(rvp) = x[1]; |
| 1516 } | 1611 } |
| 1517 } | 1612 } |
| 1518 #endif /*No_Hex_NaN*/ | 1613 #endif /*No_Hex_NaN*/ |
| 1519 #endif /* INFNAN_CHECK */ | 1614 #endif /* INFNAN_CHECK */ |
| 1520 | 1615 |
| 1616 #ifdef Pack_32 |
| 1617 #define ULbits 32 |
| 1618 #define kshift 5 |
| 1619 #define kmask 31 |
| 1620 #else |
| 1621 #define ULbits 16 |
| 1622 #define kshift 4 |
| 1623 #define kmask 15 |
| 1624 #endif |
| 1625 #ifndef NO_HEX_FP /*{*/ |
| 1626 |
| 1627 static void |
| 1628 #ifdef KR_headers |
| 1629 rshift(b, k) Bigint *b; int k; |
| 1630 #else |
| 1631 rshift(Bigint *b, int k) |
| 1632 #endif |
| 1633 { |
| 1634 ULong *x, *x1, *xe, y; |
| 1635 int n; |
| 1636 |
| 1637 x = x1 = b->x; |
| 1638 n = k >> kshift; |
| 1639 if (n < b->wds) { |
| 1640 xe = x + b->wds; |
| 1641 x += n; |
| 1642 if (k &= kmask) { |
| 1643 n = 32 - k; |
| 1644 y = *x++ >> k; |
| 1645 while(x < xe) { |
| 1646 *x1++ = (y | (*x << n)) & 0xffffffff; |
| 1647 y = *x++ >> k; |
| 1648 } |
| 1649 if ((*x1 = y) !=0) |
| 1650 x1++; |
| 1651 } |
| 1652 else |
| 1653 while(x < xe) |
| 1654 *x1++ = *x++; |
| 1655 } |
| 1656 if ((b->wds = x1 - b->x) == 0) |
| 1657 b->x[0] = 0; |
| 1658 } |
| 1659 |
| 1660 static ULong |
| 1661 #ifdef KR_headers |
| 1662 any_on(b, k) Bigint *b; int k; |
| 1663 #else |
| 1664 any_on(Bigint *b, int k) |
| 1665 #endif |
| 1666 { |
| 1667 int n, nwds; |
| 1668 ULong *x, *x0, x1, x2; |
| 1669 |
| 1670 x = b->x; |
| 1671 nwds = b->wds; |
| 1672 n = k >> kshift; |
| 1673 if (n > nwds) |
| 1674 n = nwds; |
| 1675 else if (n < nwds && (k &= kmask)) { |
| 1676 x1 = x2 = x[n]; |
| 1677 x1 >>= k; |
| 1678 x1 <<= k; |
| 1679 if (x1 != x2) |
| 1680 return 1; |
| 1681 } |
| 1682 x0 = x; |
| 1683 x += n; |
| 1684 while(x > x0) |
| 1685 if (*--x) |
| 1686 return 1; |
| 1687 return 0; |
| 1688 } |
| 1689 |
| 1690 enum { /* rounding values: same as FLT_ROUNDS */ |
| 1691 Round_zero = 0, |
| 1692 Round_near = 1, |
| 1693 Round_up = 2, |
| 1694 Round_down = 3 |
| 1695 }; |
| 1696 |
| 1697 static Bigint * |
| 1698 #ifdef KR_headers |
| 1699 increment(b) Bigint *b; |
| 1700 #else |
| 1701 increment(Bigint *b) |
| 1702 #endif |
| 1703 { |
| 1704 ULong *x, *xe; |
| 1705 Bigint *b1; |
| 1706 |
| 1707 x = b->x; |
| 1708 xe = x + b->wds; |
| 1709 do { |
| 1710 if (*x < (ULong)0xffffffffL) { |
| 1711 ++*x; |
| 1712 return b; |
| 1713 } |
| 1714 *x++ = 0; |
| 1715 } while(x < xe); |
| 1716 { |
| 1717 if (b->wds >= b->maxwds) { |
| 1718 b1 = Balloc(b->k+1); |
| 1719 Bcopy(b1,b); |
| 1720 Bfree(b); |
| 1721 b = b1; |
| 1722 } |
| 1723 b->x[b->wds++] = 1; |
| 1724 } |
| 1725 return b; |
| 1726 } |
| 1727 |
| 1728 void |
| 1729 #ifdef KR_headers |
| 1730 gethex(sp, rvp, rounding, sign) |
| 1731 CONST char **sp; U *rvp; int rounding, sign; |
| 1732 #else |
| 1733 gethex( CONST char **sp, U *rvp, int rounding, int sign) |
| 1734 #endif |
| 1735 { |
| 1736 Bigint *b; |
| 1737 CONST unsigned char *decpt, *s0, *s, *s1; |
| 1738 Long e, e1; |
| 1739 ULong L, lostbits, *x; |
| 1740 int big, denorm, esign, havedig, k, n, nbits, up, zret; |
| 1741 #ifdef IBM |
| 1742 int j; |
| 1743 #endif |
| 1744 enum { |
| 1745 #ifdef IEEE_Arith /*{{*/ |
| 1746 emax = 0x7fe - Bias - P + 1, |
| 1747 emin = Emin - P + 1 |
| 1748 #else /*}{*/ |
| 1749 emin = Emin - P, |
| 1750 #ifdef VAX |
| 1751 emax = 0x7ff - Bias - P + 1 |
| 1752 #endif |
| 1753 #ifdef IBM |
| 1754 emax = 0x7f - Bias - P |
| 1755 #endif |
| 1756 #endif /*}}*/ |
| 1757 }; |
| 1758 #ifdef USE_LOCALE |
| 1759 int i; |
| 1760 #ifdef NO_LOCALE_CACHE |
| 1761 const unsigned char *decimalpoint = (unsigned char*) |
| 1762 localeconv()->decimal_point; |
| 1763 #else |
| 1764 const unsigned char *decimalpoint; |
| 1765 static unsigned char *decimalpoint_cache; |
| 1766 if (!(s0 = decimalpoint_cache)) { |
| 1767 s0 = (unsigned char*)localeconv()->decimal_point; |
| 1768 if ((decimalpoint_cache = (unsigned char*) |
| 1769 MALLOC(strlen((CONST char*)s0) + 1))) { |
| 1770 strcpy((char*)decimalpoint_cache, (CONST char*)s0); |
| 1771 s0 = decimalpoint_cache; |
| 1772 } |
| 1773 } |
| 1774 decimalpoint = s0; |
| 1775 #endif |
| 1776 #endif |
| 1777 |
| 1778 if (!hexdig['0']) |
| 1779 hexdig_init(); |
| 1780 havedig = 0; |
| 1781 s0 = *(CONST unsigned char **)sp + 2; |
| 1782 while(s0[havedig] == '0') |
| 1783 havedig++; |
| 1784 s0 += havedig; |
| 1785 s = s0; |
| 1786 decpt = 0; |
| 1787 zret = 0; |
| 1788 e = 0; |
| 1789 if (hexdig[*s]) |
| 1790 havedig++; |
| 1791 else { |
| 1792 zret = 1; |
| 1793 #ifdef USE_LOCALE |
| 1794 for(i = 0; decimalpoint[i]; ++i) { |
| 1795 if (s[i] != decimalpoint[i]) |
| 1796 goto pcheck; |
| 1797 } |
| 1798 decpt = s += i; |
| 1799 #else |
| 1800 if (*s != '.') |
| 1801 goto pcheck; |
| 1802 decpt = ++s; |
| 1803 #endif |
| 1804 if (!hexdig[*s]) |
| 1805 goto pcheck; |
| 1806 while(*s == '0') |
| 1807 s++; |
| 1808 if (hexdig[*s]) |
| 1809 zret = 0; |
| 1810 havedig = 1; |
| 1811 s0 = s; |
| 1812 } |
| 1813 while(hexdig[*s]) |
| 1814 s++; |
| 1815 #ifdef USE_LOCALE |
| 1816 if (*s == *decimalpoint && !decpt) { |
| 1817 for(i = 1; decimalpoint[i]; ++i) { |
| 1818 if (s[i] != decimalpoint[i]) |
| 1819 goto pcheck; |
| 1820 } |
| 1821 decpt = s += i; |
| 1822 #else |
| 1823 if (*s == '.' && !decpt) { |
| 1824 decpt = ++s; |
| 1825 #endif |
| 1826 while(hexdig[*s]) |
| 1827 s++; |
| 1828 }/*}*/ |
| 1829 if (decpt) |
| 1830 e = -(((Long)(s-decpt)) << 2); |
| 1831 pcheck: |
| 1832 s1 = s; |
| 1833 big = esign = 0; |
| 1834 switch(*s) { |
| 1835 case 'p': |
| 1836 case 'P': |
| 1837 switch(*++s) { |
| 1838 case '-': |
| 1839 esign = 1; |
| 1840 /* no break */ |
| 1841 case '+': |
| 1842 s++; |
| 1843 } |
| 1844 if ((n = hexdig[*s]) == 0 || n > 0x19) { |
| 1845 s = s1; |
| 1846 break; |
| 1847 } |
| 1848 e1 = n - 0x10; |
| 1849 while((n = hexdig[*++s]) !=0 && n <= 0x19) { |
| 1850 if (e1 & 0xf8000000) |
| 1851 big = 1; |
| 1852 e1 = 10*e1 + n - 0x10; |
| 1853 } |
| 1854 if (esign) |
| 1855 e1 = -e1; |
| 1856 e += e1; |
| 1857 } |
| 1858 *sp = (char*)s; |
| 1859 if (!havedig) |
| 1860 *sp = (char*)s0 - 1; |
| 1861 if (zret) |
| 1862 goto retz1; |
| 1863 if (big) { |
| 1864 if (esign) { |
| 1865 #ifdef IEEE_Arith |
| 1866 switch(rounding) { |
| 1867 case Round_up: |
| 1868 if (sign) |
| 1869 break; |
| 1870 goto ret_tiny; |
| 1871 case Round_down: |
| 1872 if (!sign) |
| 1873 break; |
| 1874 goto ret_tiny; |
| 1875 } |
| 1876 #endif |
| 1877 goto retz; |
| 1878 #ifdef IEEE_Arith |
| 1879 ret_tiny: |
| 1880 #ifndef NO_ERRNO |
| 1881 errno = ERANGE; |
| 1882 #endif |
| 1883 word0(rvp) = 0; |
| 1884 word1(rvp) = 1; |
| 1885 return; |
| 1886 #endif /* IEEE_Arith */ |
| 1887 } |
| 1888 switch(rounding) { |
| 1889 case Round_near: |
| 1890 goto ovfl1; |
| 1891 case Round_up: |
| 1892 if (!sign) |
| 1893 goto ovfl1; |
| 1894 goto ret_big; |
| 1895 case Round_down: |
| 1896 if (sign) |
| 1897 goto ovfl1; |
| 1898 goto ret_big; |
| 1899 } |
| 1900 ret_big: |
| 1901 word0(rvp) = Big0; |
| 1902 word1(rvp) = Big1; |
| 1903 return; |
| 1904 } |
| 1905 n = s1 - s0 - 1; |
| 1906 for(k = 0; n > (1 << (kshift-2)) - 1; n >>= 1) |
| 1907 k++; |
| 1908 b = Balloc(k); |
| 1909 x = b->x; |
| 1910 n = 0; |
| 1911 L = 0; |
| 1912 #ifdef USE_LOCALE |
| 1913 for(i = 0; decimalpoint[i+1]; ++i); |
| 1914 #endif |
| 1915 while(s1 > s0) { |
| 1916 #ifdef USE_LOCALE |
| 1917 if (*--s1 == decimalpoint[i]) { |
| 1918 s1 -= i; |
| 1919 continue; |
| 1920 } |
| 1921 #else |
| 1922 if (*--s1 == '.') |
| 1923 continue; |
| 1924 #endif |
| 1925 if (n == ULbits) { |
| 1926 *x++ = L; |
| 1927 L = 0; |
| 1928 n = 0; |
| 1929 } |
| 1930 L |= (hexdig[*s1] & 0x0f) << n; |
| 1931 n += 4; |
| 1932 } |
| 1933 *x++ = L; |
| 1934 b->wds = n = x - b->x; |
| 1935 n = ULbits*n - hi0bits(L); |
| 1936 nbits = Nbits; |
| 1937 lostbits = 0; |
| 1938 x = b->x; |
| 1939 if (n > nbits) { |
| 1940 n -= nbits; |
| 1941 if (any_on(b,n)) { |
| 1942 lostbits = 1; |
| 1943 k = n - 1; |
| 1944 if (x[k>>kshift] & 1 << (k & kmask)) { |
| 1945 lostbits = 2; |
| 1946 if (k > 0 && any_on(b,k)) |
| 1947 lostbits = 3; |
| 1948 } |
| 1949 } |
| 1950 rshift(b, n); |
| 1951 e += n; |
| 1952 } |
| 1953 else if (n < nbits) { |
| 1954 n = nbits - n; |
| 1955 b = lshift(b, n); |
| 1956 e -= n; |
| 1957 x = b->x; |
| 1958 } |
| 1959 if (e > Emax) { |
| 1960 ovfl: |
| 1961 Bfree(b); |
| 1962 ovfl1: |
| 1963 #ifndef NO_ERRNO |
| 1964 errno = ERANGE; |
| 1965 #endif |
| 1966 word0(rvp) = Exp_mask; |
| 1967 word1(rvp) = 0; |
| 1968 return; |
| 1969 } |
| 1970 denorm = 0; |
| 1971 if (e < emin) { |
| 1972 denorm = 1; |
| 1973 n = emin - e; |
| 1974 if (n >= nbits) { |
| 1975 #ifdef IEEE_Arith /*{*/ |
| 1976 switch (rounding) { |
| 1977 case Round_near: |
| 1978 if (n == nbits && (n < 2 || any_on(b,n-1))) |
| 1979 goto ret_tiny; |
| 1980 break; |
| 1981 case Round_up: |
| 1982 if (!sign) |
| 1983 goto ret_tiny; |
| 1984 break; |
| 1985 case Round_down: |
| 1986 if (sign) |
| 1987 goto ret_tiny; |
| 1988 } |
| 1989 #endif /* } IEEE_Arith */ |
| 1990 Bfree(b); |
| 1991 retz: |
| 1992 #ifndef NO_ERRNO |
| 1993 errno = ERANGE; |
| 1994 #endif |
| 1995 retz1: |
| 1996 rvp->d = 0.; |
| 1997 return; |
| 1998 } |
| 1999 k = n - 1; |
| 2000 if (lostbits) |
| 2001 lostbits = 1; |
| 2002 else if (k > 0) |
| 2003 lostbits = any_on(b,k); |
| 2004 if (x[k>>kshift] & 1 << (k & kmask)) |
| 2005 lostbits |= 2; |
| 2006 nbits -= n; |
| 2007 rshift(b,n); |
| 2008 e = emin; |
| 2009 } |
| 2010 if (lostbits) { |
| 2011 up = 0; |
| 2012 switch(rounding) { |
| 2013 case Round_zero: |
| 2014 break; |
| 2015 case Round_near: |
| 2016 if (lostbits & 2 |
| 2017 && (lostbits & 1) | (x[0] & 1)) |
| 2018 up = 1; |
| 2019 break; |
| 2020 case Round_up: |
| 2021 up = 1 - sign; |
| 2022 break; |
| 2023 case Round_down: |
| 2024 up = sign; |
| 2025 } |
| 2026 if (up) { |
| 2027 k = b->wds; |
| 2028 b = increment(b); |
| 2029 x = b->x; |
| 2030 if (denorm) { |
| 2031 #if 0 |
| 2032 if (nbits == Nbits - 1 |
| 2033 && x[nbits >> kshift] & 1 << (nbits & kmask)) |
| 2034 denorm = 0; /* not currently used */ |
| 2035 #endif |
| 2036 } |
| 2037 else if (b->wds > k |
| 2038 || ((n = nbits & kmask) !=0 |
| 2039 && hi0bits(x[k-1]) < 32-n)) { |
| 2040 rshift(b,1); |
| 2041 if (++e > Emax) |
| 2042 goto ovfl; |
| 2043 } |
| 2044 } |
| 2045 } |
| 2046 #ifdef IEEE_Arith |
| 2047 if (denorm) |
| 2048 word0(rvp) = b->wds > 1 ? b->x[1] & ~0x100000 : 0; |
| 2049 else |
| 2050 word0(rvp) = (b->x[1] & ~0x100000) | ((e + 0x3ff + 52) << 20); |
| 2051 word1(rvp) = b->x[0]; |
| 2052 #endif |
| 2053 #ifdef IBM |
| 2054 if ((j = e & 3)) { |
| 2055 k = b->x[0] & ((1 << j) - 1); |
| 2056 rshift(b,j); |
| 2057 if (k) { |
| 2058 switch(rounding) { |
| 2059 case Round_up: |
| 2060 if (!sign) |
| 2061 increment(b); |
| 2062 break; |
| 2063 case Round_down: |
| 2064 if (sign) |
| 2065 increment(b); |
| 2066 break; |
| 2067 case Round_near: |
| 2068 j = 1 << (j-1); |
| 2069 if (k & j && ((k & (j-1)) | lostbits)) |
| 2070 increment(b); |
| 2071 } |
| 2072 } |
| 2073 } |
| 2074 e >>= 2; |
| 2075 word0(rvp) = b->x[1] | ((e + 65 + 13) << 24); |
| 2076 word1(rvp) = b->x[0]; |
| 2077 #endif |
| 2078 #ifdef VAX |
| 2079 /* The next two lines ignore swap of low- and high-order 2 bytes. */ |
| 2080 /* word0(rvp) = (b->x[1] & ~0x800000) | ((e + 129 + 55) << 23); */ |
| 2081 /* word1(rvp) = b->x[0]; */ |
| 2082 word0(rvp) = ((b->x[1] & ~0x800000) >> 16) | ((e + 129 + 55) << 7) | (b-
>x[1] << 16); |
| 2083 word1(rvp) = (b->x[0] >> 16) | (b->x[0] << 16); |
| 2084 #endif |
| 2085 Bfree(b); |
| 2086 } |
| 2087 #endif /*}!NO_HEX_FP*/ |
| 2088 |
| 2089 static int |
| 2090 #ifdef KR_headers |
| 2091 dshift(b, p2) Bigint *b; int p2; |
| 2092 #else |
| 2093 dshift(Bigint *b, int p2) |
| 2094 #endif |
| 2095 { |
| 2096 int rv = hi0bits(b->x[b->wds-1]) - 4; |
| 2097 if (p2 > 0) |
| 2098 rv -= p2; |
| 2099 return rv & kmask; |
| 2100 } |
| 2101 |
| 2102 static int |
| 2103 quorem |
| 2104 #ifdef KR_headers |
| 2105 (b, S) Bigint *b, *S; |
| 2106 #else |
| 2107 (Bigint *b, Bigint *S) |
| 2108 #endif |
| 2109 { |
| 2110 int n; |
| 2111 ULong *bx, *bxe, q, *sx, *sxe; |
| 2112 #ifdef ULLong |
| 2113 ULLong borrow, carry, y, ys; |
| 2114 #else |
| 2115 ULong borrow, carry, y, ys; |
| 2116 #ifdef Pack_32 |
| 2117 ULong si, z, zs; |
| 2118 #endif |
| 2119 #endif |
| 2120 |
| 2121 n = S->wds; |
| 2122 #ifdef DEBUG |
| 2123 /*debug*/ if (b->wds > n) |
| 2124 /*debug*/ Bug("oversize b in quorem"); |
| 2125 #endif |
| 2126 if (b->wds < n) |
| 2127 return 0; |
| 2128 sx = S->x; |
| 2129 sxe = sx + --n; |
| 2130 bx = b->x; |
| 2131 bxe = bx + n; |
| 2132 q = *bxe / (*sxe + 1); /* ensure q <= true quotient */ |
| 2133 #ifdef DEBUG |
| 2134 /*debug*/ if (q > 9) |
| 2135 /*debug*/ Bug("oversized quotient in quorem"); |
| 2136 #endif |
| 2137 if (q) { |
| 2138 borrow = 0; |
| 2139 carry = 0; |
| 2140 do { |
| 2141 #ifdef ULLong |
| 2142 ys = *sx++ * (ULLong)q + carry; |
| 2143 carry = ys >> 32; |
| 2144 y = *bx - (ys & FFFFFFFF) - borrow; |
| 2145 borrow = y >> 32 & (ULong)1; |
| 2146 *bx++ = y & FFFFFFFF; |
| 2147 #else |
| 2148 #ifdef Pack_32 |
| 2149 si = *sx++; |
| 2150 ys = (si & 0xffff) * q + carry; |
| 2151 zs = (si >> 16) * q + (ys >> 16); |
| 2152 carry = zs >> 16; |
| 2153 y = (*bx & 0xffff) - (ys & 0xffff) - borrow; |
| 2154 borrow = (y & 0x10000) >> 16; |
| 2155 z = (*bx >> 16) - (zs & 0xffff) - borrow; |
| 2156 borrow = (z & 0x10000) >> 16; |
| 2157 Storeinc(bx, z, y); |
| 2158 #else |
| 2159 ys = *sx++ * q + carry; |
| 2160 carry = ys >> 16; |
| 2161 y = *bx - (ys & 0xffff) - borrow; |
| 2162 borrow = (y & 0x10000) >> 16; |
| 2163 *bx++ = y & 0xffff; |
| 2164 #endif |
| 2165 #endif |
| 2166 } |
| 2167 while(sx <= sxe); |
| 2168 if (!*bxe) { |
| 2169 bx = b->x; |
| 2170 while(--bxe > bx && !*bxe) |
| 2171 --n; |
| 2172 b->wds = n; |
| 2173 } |
| 2174 } |
| 2175 if (cmp(b, S) >= 0) { |
| 2176 q++; |
| 2177 borrow = 0; |
| 2178 carry = 0; |
| 2179 bx = b->x; |
| 2180 sx = S->x; |
| 2181 do { |
| 2182 #ifdef ULLong |
| 2183 ys = *sx++ + carry; |
| 2184 carry = ys >> 32; |
| 2185 y = *bx - (ys & FFFFFFFF) - borrow; |
| 2186 borrow = y >> 32 & (ULong)1; |
| 2187 *bx++ = y & FFFFFFFF; |
| 2188 #else |
| 2189 #ifdef Pack_32 |
| 2190 si = *sx++; |
| 2191 ys = (si & 0xffff) + carry; |
| 2192 zs = (si >> 16) + (ys >> 16); |
| 2193 carry = zs >> 16; |
| 2194 y = (*bx & 0xffff) - (ys & 0xffff) - borrow; |
| 2195 borrow = (y & 0x10000) >> 16; |
| 2196 z = (*bx >> 16) - (zs & 0xffff) - borrow; |
| 2197 borrow = (z & 0x10000) >> 16; |
| 2198 Storeinc(bx, z, y); |
| 2199 #else |
| 2200 ys = *sx++ + carry; |
| 2201 carry = ys >> 16; |
| 2202 y = *bx - (ys & 0xffff) - borrow; |
| 2203 borrow = (y & 0x10000) >> 16; |
| 2204 *bx++ = y & 0xffff; |
| 2205 #endif |
| 2206 #endif |
| 2207 } |
| 2208 while(sx <= sxe); |
| 2209 bx = b->x; |
| 2210 bxe = bx + n; |
| 2211 if (!*bxe) { |
| 2212 while(--bxe > bx && !*bxe) |
| 2213 --n; |
| 2214 b->wds = n; |
| 2215 } |
| 2216 } |
| 2217 return q; |
| 2218 } |
| 2219 |
| 2220 #ifndef NO_STRTOD_BIGCOMP |
| 2221 |
| 2222 static void |
| 2223 bigcomp |
| 2224 #ifdef KR_headers |
| 2225 (rv, s0, bc) |
| 2226 U *rv; CONST char *s0; BCinfo *bc; |
| 2227 #else |
| 2228 (U *rv, CONST char *s0, BCinfo *bc) |
| 2229 #endif |
| 2230 { |
| 2231 Bigint *b, *d; |
| 2232 int b2, bbits, d2, dd, dig, dsign, i, j, nd, nd0, p2, p5, speccase; |
| 2233 |
| 2234 dsign = bc->dsign; |
| 2235 nd = bc->nd; |
| 2236 nd0 = bc->nd0; |
| 2237 p5 = nd + bc->e0 - 1; |
| 2238 dd = speccase = 0; |
| 2239 #ifndef Sudden_Underflow |
| 2240 if (rv->d == 0.) { /* special case: value near underflow-to-zero */ |
| 2241 /* threshold was rounded to zero */ |
| 2242 b = i2b(1); |
| 2243 p2 = Emin - P + 1; |
| 2244 bbits = 1; |
| 2245 #ifdef Avoid_Underflow |
| 2246 word0(rv) = (P+2) << Exp_shift; |
| 2247 #else |
| 2248 word1(rv) = 1; |
| 2249 #endif |
| 2250 i = 0; |
| 2251 #ifdef Honor_FLT_ROUNDS |
| 2252 if (bc->rounding == 1) |
| 2253 #endif |
| 2254 { |
| 2255 speccase = 1; |
| 2256 --p2; |
| 2257 dsign = 0; |
| 2258 goto have_i; |
| 2259 } |
| 2260 } |
| 2261 else |
| 2262 #endif |
| 2263 b = d2b(rv, &p2, &bbits); |
| 2264 #ifdef Avoid_Underflow |
| 2265 p2 -= bc->scale; |
| 2266 #endif |
| 2267 /* floor(log2(rv)) == bbits - 1 + p2 */ |
| 2268 /* Check for denormal case. */ |
| 2269 i = P - bbits; |
| 2270 if (i > (j = P - Emin - 1 + p2)) { |
| 2271 #ifdef Sudden_Underflow |
| 2272 Bfree(b); |
| 2273 b = i2b(1); |
| 2274 p2 = Emin; |
| 2275 i = P - 1; |
| 2276 #ifdef Avoid_Underflow |
| 2277 word0(rv) = (1 + bc->scale) << Exp_shift; |
| 2278 #else |
| 2279 word0(rv) = Exp_msk1; |
| 2280 #endif |
| 2281 word1(rv) = 0; |
| 2282 #else |
| 2283 i = j; |
| 2284 #endif |
| 2285 } |
| 2286 #ifdef Honor_FLT_ROUNDS |
| 2287 if (bc->rounding != 1) { |
| 2288 if (i > 0) |
| 2289 b = lshift(b, i); |
| 2290 if (dsign) |
| 2291 b = increment(b); |
| 2292 } |
| 2293 else |
| 2294 #endif |
| 2295 { |
| 2296 b = lshift(b, ++i); |
| 2297 b->x[0] |= 1; |
| 2298 } |
| 2299 #ifndef Sudden_Underflow |
| 2300 have_i: |
| 2301 #endif |
| 2302 p2 -= p5 + i; |
| 2303 d = i2b(1); |
| 2304 /* Arrange for convenient computation of quotients: |
| 2305 * shift left if necessary so divisor has 4 leading 0 bits. |
| 2306 */ |
| 2307 if (p5 > 0) |
| 2308 d = pow5mult(d, p5); |
| 2309 else if (p5 < 0) |
| 2310 b = pow5mult(b, -p5); |
| 2311 if (p2 > 0) { |
| 2312 b2 = p2; |
| 2313 d2 = 0; |
| 2314 } |
| 2315 else { |
| 2316 b2 = 0; |
| 2317 d2 = -p2; |
| 2318 } |
| 2319 i = dshift(d, d2); |
| 2320 if ((b2 += i) > 0) |
| 2321 b = lshift(b, b2); |
| 2322 if ((d2 += i) > 0) |
| 2323 d = lshift(d, d2); |
| 2324 |
| 2325 /* Now b/d = exactly half-way between the two floating-point values */ |
| 2326 /* on either side of the input string. Compute first digit of b/d. */ |
| 2327 |
| 2328 if (!(dig = quorem(b,d))) { |
| 2329 b = multadd(b, 10, 0); /* very unlikely */ |
| 2330 dig = quorem(b,d); |
| 2331 } |
| 2332 |
| 2333 /* Compare b/d with s0 */ |
| 2334 |
| 2335 for(i = 0; i < nd0; ) { |
| 2336 if ((dd = s0[i++] - '0' - dig)) |
| 2337 goto ret; |
| 2338 if (!b->x[0] && b->wds == 1) { |
| 2339 if (i < nd) |
| 2340 dd = 1; |
| 2341 goto ret; |
| 2342 } |
| 2343 b = multadd(b, 10, 0); |
| 2344 dig = quorem(b,d); |
| 2345 } |
| 2346 for(j = bc->dp1; i++ < nd;) { |
| 2347 if ((dd = s0[j++] - '0' - dig)) |
| 2348 goto ret; |
| 2349 if (!b->x[0] && b->wds == 1) { |
| 2350 if (i < nd) |
| 2351 dd = 1; |
| 2352 goto ret; |
| 2353 } |
| 2354 b = multadd(b, 10, 0); |
| 2355 dig = quorem(b,d); |
| 2356 } |
| 2357 if (b->x[0] || b->wds > 1) |
| 2358 dd = -1; |
| 2359 ret: |
| 2360 Bfree(b); |
| 2361 Bfree(d); |
| 2362 #ifdef Honor_FLT_ROUNDS |
| 2363 if (bc->rounding != 1) { |
| 2364 if (dd < 0) { |
| 2365 if (bc->rounding == 0) { |
| 2366 if (!dsign) |
| 2367 goto retlow1; |
| 2368 } |
| 2369 else if (dsign) |
| 2370 goto rethi1; |
| 2371 } |
| 2372 else if (dd > 0) { |
| 2373 if (bc->rounding == 0) { |
| 2374 if (dsign) |
| 2375 goto rethi1; |
| 2376 goto ret1; |
| 2377 } |
| 2378 if (!dsign) |
| 2379 goto rethi1; |
| 2380 dval(rv) += 2.*ulp(rv); |
| 2381 } |
| 2382 else { |
| 2383 bc->inexact = 0; |
| 2384 if (dsign) |
| 2385 goto rethi1; |
| 2386 } |
| 2387 } |
| 2388 else |
| 2389 #endif |
| 2390 if (speccase) { |
| 2391 if (dd <= 0) |
| 2392 rv->d = 0.; |
| 2393 } |
| 2394 else if (dd < 0) { |
| 2395 if (!dsign) /* does not happen for round-near */ |
| 2396 retlow1: |
| 2397 dval(rv) -= ulp(rv); |
| 2398 } |
| 2399 else if (dd > 0) { |
| 2400 if (dsign) { |
| 2401 rethi1: |
| 2402 dval(rv) += ulp(rv); |
| 2403 } |
| 2404 } |
| 2405 else { |
| 2406 /* Exact half-way case: apply round-even rule. */ |
| 2407 if (word1(rv) & 1) { |
| 2408 if (dsign) |
| 2409 goto rethi1; |
| 2410 goto retlow1; |
| 2411 } |
| 2412 } |
| 2413 |
| 2414 #ifdef Honor_FLT_ROUNDS |
| 2415 ret1: |
| 2416 #endif |
| 2417 return; |
| 2418 } |
| 2419 #endif /* NO_STRTOD_BIGCOMP */ |
| 2420 |
| 1521 double | 2421 double |
| 1522 strtod | 2422 strtod |
| 1523 #ifdef KR_headers | 2423 #ifdef KR_headers |
| 1524 (s00, se) CONST char *s00; char **se; | 2424 (s00, se) CONST char *s00; char **se; |
| 1525 #else | 2425 #else |
| 1526 (CONST char *s00, char **se) | 2426 (CONST char *s00, char **se) |
| 1527 #endif | 2427 #endif |
| 1528 { | 2428 { |
| 1529 #ifdef Avoid_Underflow | 2429 » int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, e, e1; |
| 1530 » int scale; | 2430 » int esign, i, j, k, nd, nd0, nf, nz, nz0, sign; |
| 1531 #endif | |
| 1532 » int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign, | |
| 1533 » » e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign; | |
| 1534 CONST char *s, *s0, *s1; | 2431 CONST char *s, *s0, *s1; |
| 1535 » double aadj, aadj1, adj, rv, rv0; | 2432 » double aadj, aadj1; |
| 1536 Long L; | 2433 Long L; |
| 2434 U aadj2, adj, rv, rv0; |
| 1537 ULong y, z; | 2435 ULong y, z; |
| 2436 BCinfo bc; |
| 1538 Bigint *bb, *bb1, *bd, *bd0, *bs, *delta; | 2437 Bigint *bb, *bb1, *bd, *bd0, *bs, *delta; |
| 1539 #ifdef SET_INEXACT | 2438 #ifdef SET_INEXACT |
| 1540 » int inexact, oldinexact; | 2439 » int oldinexact; |
| 1541 #endif | 2440 #endif |
| 1542 #ifdef Honor_FLT_ROUNDS | 2441 #ifdef Honor_FLT_ROUNDS /*{*/ |
| 1543 » int rounding; | 2442 #ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */ |
| 1544 #endif | 2443 » bc.rounding = Flt_Rounds; |
| 2444 #else /*}{*/ |
| 2445 » bc.rounding = 1; |
| 2446 » switch(fegetround()) { |
| 2447 » case FE_TOWARDZERO:» bc.rounding = 0; break; |
| 2448 » case FE_UPWARD:» bc.rounding = 2; break; |
| 2449 » case FE_DOWNWARD:» bc.rounding = 3; |
| 2450 » } |
| 2451 #endif /*}}*/ |
| 2452 #endif /*}*/ |
| 1545 #ifdef USE_LOCALE | 2453 #ifdef USE_LOCALE |
| 1546 CONST char *s2; | 2454 CONST char *s2; |
| 1547 #endif | 2455 #endif |
| 1548 | 2456 |
| 1549 » sign = nz0 = nz = 0; | 2457 » sign = nz0 = nz = bc.dplen = bc.uflchk = 0; |
| 1550 » dval(rv) = 0.; | 2458 » dval(&rv) = 0.; |
| 1551 for(s = s00;;s++) switch(*s) { | 2459 for(s = s00;;s++) switch(*s) { |
| 1552 case '-': | 2460 case '-': |
| 1553 sign = 1; | 2461 sign = 1; |
| 1554 /* no break */ | 2462 /* no break */ |
| 1555 case '+': | 2463 case '+': |
| 1556 if (*++s) | 2464 if (*++s) |
| 1557 goto break2; | 2465 goto break2; |
| 1558 /* no break */ | 2466 /* no break */ |
| 1559 case 0: | 2467 case 0: |
| 1560 goto ret0; | 2468 goto ret0; |
| 1561 case '\t': | 2469 case '\t': |
| 1562 case '\n': | 2470 case '\n': |
| 1563 case '\v': | 2471 case '\v': |
| 1564 case '\f': | 2472 case '\f': |
| 1565 case '\r': | 2473 case '\r': |
| 1566 case ' ': | 2474 case ' ': |
| 1567 continue; | 2475 continue; |
| 1568 default: | 2476 default: |
| 1569 goto break2; | 2477 goto break2; |
| 1570 } | 2478 } |
| 1571 break2: | 2479 break2: |
| 1572 if (*s == '0') { | 2480 if (*s == '0') { |
| 2481 #ifndef NO_HEX_FP /*{*/ |
| 2482 switch(s[1]) { |
| 2483 case 'x': |
| 2484 case 'X': |
| 2485 #ifdef Honor_FLT_ROUNDS |
| 2486 gethex(&s, &rv, bc.rounding, sign); |
| 2487 #else |
| 2488 gethex(&s, &rv, 1, sign); |
| 2489 #endif |
| 2490 goto ret; |
| 2491 } |
| 2492 #endif /*}*/ |
| 1573 nz0 = 1; | 2493 nz0 = 1; |
| 1574 while(*++s == '0') ; | 2494 while(*++s == '0') ; |
| 1575 if (!*s) | 2495 if (!*s) |
| 1576 goto ret; | 2496 goto ret; |
| 1577 } | 2497 } |
| 1578 s0 = s; | 2498 s0 = s; |
| 1579 y = z = 0; | 2499 y = z = 0; |
| 1580 for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++) | 2500 for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++) |
| 1581 if (nd < 9) | 2501 if (nd < 9) |
| 1582 y = 10*y + c - '0'; | 2502 y = 10*y + c - '0'; |
| 1583 else if (nd < 16) | 2503 else if (nd < 16) |
| 1584 z = 10*z + c - '0'; | 2504 z = 10*z + c - '0'; |
| 1585 nd0 = nd; | 2505 nd0 = nd; |
| 2506 bc.dp0 = bc.dp1 = s - s0; |
| 1586 #ifdef USE_LOCALE | 2507 #ifdef USE_LOCALE |
| 1587 s1 = localeconv()->decimal_point; | 2508 s1 = localeconv()->decimal_point; |
| 1588 if (c == *s1) { | 2509 if (c == *s1) { |
| 1589 c = '.'; | 2510 c = '.'; |
| 1590 if (*++s1) { | 2511 if (*++s1) { |
| 1591 s2 = s; | 2512 s2 = s; |
| 1592 for(;;) { | 2513 for(;;) { |
| 1593 if (*++s2 != *s1) { | 2514 if (*++s2 != *s1) { |
| 1594 c = 0; | 2515 c = 0; |
| 1595 break; | 2516 break; |
| 1596 } | 2517 } |
| 1597 if (!*++s1) { | 2518 if (!*++s1) { |
| 1598 s = s2; | 2519 s = s2; |
| 1599 break; | 2520 break; |
| 1600 } | 2521 } |
| 1601 } | 2522 } |
| 1602 } | 2523 } |
| 1603 } | 2524 } |
| 1604 #endif | 2525 #endif |
| 1605 if (c == '.') { | 2526 if (c == '.') { |
| 1606 c = *++s; | 2527 c = *++s; |
| 2528 bc.dp1 = s - s0; |
| 2529 bc.dplen = bc.dp1 - bc.dp0; |
| 1607 if (!nd) { | 2530 if (!nd) { |
| 1608 for(; c == '0'; c = *++s) | 2531 for(; c == '0'; c = *++s) |
| 1609 nz++; | 2532 nz++; |
| 1610 if (c > '0' && c <= '9') { | 2533 if (c > '0' && c <= '9') { |
| 1611 s0 = s; | 2534 s0 = s; |
| 1612 nf += nz; | 2535 nf += nz; |
| 1613 nz = 0; | 2536 nz = 0; |
| 1614 goto have_dig; | 2537 goto have_dig; |
| 1615 } | 2538 } |
| 1616 goto dig_done; | 2539 goto dig_done; |
| (...skipping 51 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 1668 else | 2591 else |
| 1669 e = 0; | 2592 e = 0; |
| 1670 } | 2593 } |
| 1671 else | 2594 else |
| 1672 s = s00; | 2595 s = s00; |
| 1673 } | 2596 } |
| 1674 if (!nd) { | 2597 if (!nd) { |
| 1675 if (!nz && !nz0) { | 2598 if (!nz && !nz0) { |
| 1676 #ifdef INFNAN_CHECK | 2599 #ifdef INFNAN_CHECK |
| 1677 /* Check for Nan and Infinity */ | 2600 /* Check for Nan and Infinity */ |
| 1678 » » » switch(c) { | 2601 » » » if (!bc.dplen) |
| 2602 » » » switch(c) { |
| 1679 case 'i': | 2603 case 'i': |
| 1680 case 'I': | 2604 case 'I': |
| 1681 if (match(&s,"nf")) { | 2605 if (match(&s,"nf")) { |
| 1682 --s; | 2606 --s; |
| 1683 if (!match(&s,"inity")) | 2607 if (!match(&s,"inity")) |
| 1684 ++s; | 2608 ++s; |
| 1685 » » » » » word0(rv) = 0x7ff00000; | 2609 » » » » » word0(&rv) = 0x7ff00000; |
| 1686 » » » » » word1(rv) = 0; | 2610 » » » » » word1(&rv) = 0; |
| 1687 goto ret; | 2611 goto ret; |
| 1688 } | 2612 } |
| 1689 break; | 2613 break; |
| 1690 case 'n': | 2614 case 'n': |
| 1691 case 'N': | 2615 case 'N': |
| 1692 if (match(&s, "an")) { | 2616 if (match(&s, "an")) { |
| 1693 » » » » » word0(rv) = NAN_WORD0; | 2617 » » » » » word0(&rv) = NAN_WORD0; |
| 1694 » » » » » word1(rv) = NAN_WORD1; | 2618 » » » » » word1(&rv) = NAN_WORD1; |
| 1695 #ifndef No_Hex_NaN | 2619 #ifndef No_Hex_NaN |
| 1696 if (*s == '(') /*)*/ | 2620 if (*s == '(') /*)*/ |
| 1697 hexnan(&rv, &s); | 2621 hexnan(&rv, &s); |
| 1698 #endif | 2622 #endif |
| 1699 goto ret; | 2623 goto ret; |
| 1700 } | 2624 } |
| 1701 } | 2625 } |
| 1702 #endif /* INFNAN_CHECK */ | 2626 #endif /* INFNAN_CHECK */ |
| 1703 ret0: | 2627 ret0: |
| 1704 s = s00; | 2628 s = s00; |
| 1705 sign = 0; | 2629 sign = 0; |
| 1706 } | 2630 } |
| 1707 goto ret; | 2631 goto ret; |
| 1708 } | 2632 } |
| 1709 » e1 = e -= nf; | 2633 » bc.e0 = e1 = e -= nf; |
| 1710 | 2634 |
| 1711 /* Now we have nd0 digits, starting at s0, followed by a | 2635 /* Now we have nd0 digits, starting at s0, followed by a |
| 1712 * decimal point, followed by nd-nd0 digits. The number we're | 2636 * decimal point, followed by nd-nd0 digits. The number we're |
| 1713 * after is the integer represented by those digits times | 2637 * after is the integer represented by those digits times |
| 1714 * 10**e */ | 2638 * 10**e */ |
| 1715 | 2639 |
| 1716 if (!nd0) | 2640 if (!nd0) |
| 1717 nd0 = nd; | 2641 nd0 = nd; |
| 1718 k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1; | 2642 k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1; |
| 1719 » dval(rv) = y; | 2643 » dval(&rv) = y; |
| 1720 if (k > 9) { | 2644 if (k > 9) { |
| 1721 #ifdef SET_INEXACT | 2645 #ifdef SET_INEXACT |
| 1722 if (k > DBL_DIG) | 2646 if (k > DBL_DIG) |
| 1723 oldinexact = get_inexact(); | 2647 oldinexact = get_inexact(); |
| 1724 #endif | 2648 #endif |
| 1725 » » dval(rv) = tens[k - 9] * dval(rv) + z; | 2649 » » dval(&rv) = tens[k - 9] * dval(&rv) + z; |
| 1726 } | 2650 } |
| 1727 bd0 = 0; | 2651 bd0 = 0; |
| 1728 if (nd <= DBL_DIG | 2652 if (nd <= DBL_DIG |
| 1729 #ifndef RND_PRODQUOT | 2653 #ifndef RND_PRODQUOT |
| 1730 #ifndef Honor_FLT_ROUNDS | 2654 #ifndef Honor_FLT_ROUNDS |
| 1731 && Flt_Rounds == 1 | 2655 && Flt_Rounds == 1 |
| 1732 #endif | 2656 #endif |
| 1733 #endif | 2657 #endif |
| 1734 ) { | 2658 ) { |
| 1735 if (!e) | 2659 if (!e) |
| 1736 goto ret; | 2660 goto ret; |
| 1737 if (e > 0) { | 2661 if (e > 0) { |
| 1738 if (e <= Ten_pmax) { | 2662 if (e <= Ten_pmax) { |
| 1739 #ifdef VAX | 2663 #ifdef VAX |
| 1740 goto vax_ovfl_check; | 2664 goto vax_ovfl_check; |
| 1741 #else | 2665 #else |
| 1742 #ifdef Honor_FLT_ROUNDS | 2666 #ifdef Honor_FLT_ROUNDS |
| 1743 /* round correctly FLT_ROUNDS = 2 or 3 */ | 2667 /* round correctly FLT_ROUNDS = 2 or 3 */ |
| 1744 if (sign) { | 2668 if (sign) { |
| 1745 » » » » » rv = -rv; | 2669 » » » » » rv.d = -rv.d; |
| 1746 sign = 0; | 2670 sign = 0; |
| 1747 } | 2671 } |
| 1748 #endif | 2672 #endif |
| 1749 » » » » /* rv = */ rounded_product(dval(rv), tens[e]); | 2673 » » » » /* rv = */ rounded_product(dval(&rv), tens[e]); |
| 1750 goto ret; | 2674 goto ret; |
| 1751 #endif | 2675 #endif |
| 1752 } | 2676 } |
| 1753 i = DBL_DIG - nd; | 2677 i = DBL_DIG - nd; |
| 1754 if (e <= Ten_pmax + i) { | 2678 if (e <= Ten_pmax + i) { |
| 1755 /* A fancier test would sometimes let us do | 2679 /* A fancier test would sometimes let us do |
| 1756 * this for larger i values. | 2680 * this for larger i values. |
| 1757 */ | 2681 */ |
| 1758 #ifdef Honor_FLT_ROUNDS | 2682 #ifdef Honor_FLT_ROUNDS |
| 1759 /* round correctly FLT_ROUNDS = 2 or 3 */ | 2683 /* round correctly FLT_ROUNDS = 2 or 3 */ |
| 1760 if (sign) { | 2684 if (sign) { |
| 1761 » » » » » rv = -rv; | 2685 » » » » » rv.d = -rv.d; |
| 1762 sign = 0; | 2686 sign = 0; |
| 1763 } | 2687 } |
| 1764 #endif | 2688 #endif |
| 1765 e -= i; | 2689 e -= i; |
| 1766 » » » » dval(rv) *= tens[i]; | 2690 » » » » dval(&rv) *= tens[i]; |
| 1767 #ifdef VAX | 2691 #ifdef VAX |
| 1768 /* VAX exponent range is so narrow we must | 2692 /* VAX exponent range is so narrow we must |
| 1769 * worry about overflow here... | 2693 * worry about overflow here... |
| 1770 */ | 2694 */ |
| 1771 vax_ovfl_check: | 2695 vax_ovfl_check: |
| 1772 » » » » word0(rv) -= P*Exp_msk1; | 2696 » » » » word0(&rv) -= P*Exp_msk1; |
| 1773 » » » » /* rv = */ rounded_product(dval(rv), tens[e]); | 2697 » » » » /* rv = */ rounded_product(dval(&rv), tens[e]); |
| 1774 » » » » if ((word0(rv) & Exp_mask) | 2698 » » » » if ((word0(&rv) & Exp_mask) |
| 1775 > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) | 2699 > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) |
| 1776 goto ovfl; | 2700 goto ovfl; |
| 1777 » » » » word0(rv) += P*Exp_msk1; | 2701 » » » » word0(&rv) += P*Exp_msk1; |
| 1778 #else | 2702 #else |
| 1779 » » » » /* rv = */ rounded_product(dval(rv), tens[e]); | 2703 » » » » /* rv = */ rounded_product(dval(&rv), tens[e]); |
| 1780 #endif | 2704 #endif |
| 1781 goto ret; | 2705 goto ret; |
| 1782 } | 2706 } |
| 1783 } | 2707 } |
| 1784 #ifndef Inaccurate_Divide | 2708 #ifndef Inaccurate_Divide |
| 1785 else if (e >= -Ten_pmax) { | 2709 else if (e >= -Ten_pmax) { |
| 1786 #ifdef Honor_FLT_ROUNDS | 2710 #ifdef Honor_FLT_ROUNDS |
| 1787 /* round correctly FLT_ROUNDS = 2 or 3 */ | 2711 /* round correctly FLT_ROUNDS = 2 or 3 */ |
| 1788 if (sign) { | 2712 if (sign) { |
| 1789 » » » » rv = -rv; | 2713 » » » » rv.d = -rv.d; |
| 1790 sign = 0; | 2714 sign = 0; |
| 1791 } | 2715 } |
| 1792 #endif | 2716 #endif |
| 1793 » » » /* rv = */ rounded_quotient(dval(rv), tens[-e]); | 2717 » » » /* rv = */ rounded_quotient(dval(&rv), tens[-e]); |
| 1794 goto ret; | 2718 goto ret; |
| 1795 } | 2719 } |
| 1796 #endif | 2720 #endif |
| 1797 } | 2721 } |
| 1798 e1 += nd - k; | 2722 e1 += nd - k; |
| 1799 | 2723 |
| 1800 #ifdef IEEE_Arith | 2724 #ifdef IEEE_Arith |
| 1801 #ifdef SET_INEXACT | 2725 #ifdef SET_INEXACT |
| 1802 » inexact = 1; | 2726 » bc.inexact = 1; |
| 1803 if (k <= DBL_DIG) | 2727 if (k <= DBL_DIG) |
| 1804 oldinexact = get_inexact(); | 2728 oldinexact = get_inexact(); |
| 1805 #endif | 2729 #endif |
| 1806 #ifdef Avoid_Underflow | 2730 #ifdef Avoid_Underflow |
| 1807 » scale = 0; | 2731 » bc.scale = 0; |
| 1808 #endif | 2732 #endif |
| 1809 #ifdef Honor_FLT_ROUNDS | 2733 #ifdef Honor_FLT_ROUNDS |
| 1810 » if ((rounding = Flt_Rounds) >= 2) { | 2734 » if (bc.rounding >= 2) { |
| 1811 if (sign) | 2735 if (sign) |
| 1812 » » » rounding = rounding == 2 ? 0 : 2; | 2736 » » » bc.rounding = bc.rounding == 2 ? 0 : 2; |
| 1813 else | 2737 else |
| 1814 » » » if (rounding != 2) | 2738 » » » if (bc.rounding != 2) |
| 1815 » » » » rounding = 0; | 2739 » » » » bc.rounding = 0; |
| 1816 } | 2740 } |
| 1817 #endif | 2741 #endif |
| 1818 #endif /*IEEE_Arith*/ | 2742 #endif /*IEEE_Arith*/ |
| 1819 | 2743 |
| 1820 /* Get starting approximation = rv * 10**e1 */ | 2744 /* Get starting approximation = rv * 10**e1 */ |
| 1821 | 2745 |
| 1822 if (e1 > 0) { | 2746 if (e1 > 0) { |
| 1823 if ((i = e1 & 15)) | 2747 if ((i = e1 & 15)) |
| 1824 » » » dval(rv) *= tens[i]; | 2748 » » » dval(&rv) *= tens[i]; |
| 1825 if (e1 &= ~15) { | 2749 if (e1 &= ~15) { |
| 1826 if (e1 > DBL_MAX_10_EXP) { | 2750 if (e1 > DBL_MAX_10_EXP) { |
| 1827 ovfl: | 2751 ovfl: |
| 1828 #ifndef NO_ERRNO | 2752 #ifndef NO_ERRNO |
| 1829 errno = ERANGE; | 2753 errno = ERANGE; |
| 1830 #endif | 2754 #endif |
| 1831 /* Can't trust HUGE_VAL */ | 2755 /* Can't trust HUGE_VAL */ |
| 1832 #ifdef IEEE_Arith | 2756 #ifdef IEEE_Arith |
| 1833 #ifdef Honor_FLT_ROUNDS | 2757 #ifdef Honor_FLT_ROUNDS |
| 1834 » » » » switch(rounding) { | 2758 » » » » switch(bc.rounding) { |
| 1835 case 0: /* toward 0 */ | 2759 case 0: /* toward 0 */ |
| 1836 case 3: /* toward -infinity */ | 2760 case 3: /* toward -infinity */ |
| 1837 » » » » » word0(rv) = Big0; | 2761 » » » » » word0(&rv) = Big0; |
| 1838 » » » » » word1(rv) = Big1; | 2762 » » » » » word1(&rv) = Big1; |
| 1839 break; | 2763 break; |
| 1840 default: | 2764 default: |
| 1841 » » » » » word0(rv) = Exp_mask; | 2765 » » » » » word0(&rv) = Exp_mask; |
| 1842 » » » » » word1(rv) = 0; | 2766 » » » » » word1(&rv) = 0; |
| 1843 } | 2767 } |
| 1844 #else /*Honor_FLT_ROUNDS*/ | 2768 #else /*Honor_FLT_ROUNDS*/ |
| 1845 » » » » word0(rv) = Exp_mask; | 2769 » » » » word0(&rv) = Exp_mask; |
| 1846 » » » » word1(rv) = 0; | 2770 » » » » word1(&rv) = 0; |
| 1847 #endif /*Honor_FLT_ROUNDS*/ | 2771 #endif /*Honor_FLT_ROUNDS*/ |
| 1848 #ifdef SET_INEXACT | 2772 #ifdef SET_INEXACT |
| 1849 /* set overflow bit */ | 2773 /* set overflow bit */ |
| 1850 » » » » dval(rv0) = 1e300; | 2774 » » » » dval(&rv0) = 1e300; |
| 1851 » » » » dval(rv0) *= dval(rv0); | 2775 » » » » dval(&rv0) *= dval(&rv0); |
| 1852 #endif | 2776 #endif |
| 1853 #else /*IEEE_Arith*/ | 2777 #else /*IEEE_Arith*/ |
| 1854 » » » » word0(rv) = Big0; | 2778 » » » » word0(&rv) = Big0; |
| 1855 » » » » word1(rv) = Big1; | 2779 » » » » word1(&rv) = Big1; |
| 1856 #endif /*IEEE_Arith*/ | 2780 #endif /*IEEE_Arith*/ |
| 1857 if (bd0) | |
| 1858 goto retfree; | |
| 1859 goto ret; | 2781 goto ret; |
| 1860 } | 2782 } |
| 1861 e1 >>= 4; | 2783 e1 >>= 4; |
| 1862 for(j = 0; e1 > 1; j++, e1 >>= 1) | 2784 for(j = 0; e1 > 1; j++, e1 >>= 1) |
| 1863 if (e1 & 1) | 2785 if (e1 & 1) |
| 1864 » » » » » dval(rv) *= bigtens[j]; | 2786 » » » » » dval(&rv) *= bigtens[j]; |
| 1865 /* The last multiplication could overflow. */ | 2787 /* The last multiplication could overflow. */ |
| 1866 » » » word0(rv) -= P*Exp_msk1; | 2788 » » » word0(&rv) -= P*Exp_msk1; |
| 1867 » » » dval(rv) *= bigtens[j]; | 2789 » » » dval(&rv) *= bigtens[j]; |
| 1868 » » » if ((z = word0(rv) & Exp_mask) | 2790 » » » if ((z = word0(&rv) & Exp_mask) |
| 1869 > Exp_msk1*(DBL_MAX_EXP+Bias-P)) | 2791 > Exp_msk1*(DBL_MAX_EXP+Bias-P)) |
| 1870 goto ovfl; | 2792 goto ovfl; |
| 1871 if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) { | 2793 if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) { |
| 1872 /* set to largest number */ | 2794 /* set to largest number */ |
| 1873 /* (Can't trust DBL_MAX) */ | 2795 /* (Can't trust DBL_MAX) */ |
| 1874 » » » » word0(rv) = Big0; | 2796 » » » » word0(&rv) = Big0; |
| 1875 » » » » word1(rv) = Big1; | 2797 » » » » word1(&rv) = Big1; |
| 1876 } | 2798 } |
| 1877 else | 2799 else |
| 1878 » » » » word0(rv) += P*Exp_msk1; | 2800 » » » » word0(&rv) += P*Exp_msk1; |
| 1879 } | 2801 } |
| 1880 } | 2802 } |
| 1881 else if (e1 < 0) { | 2803 else if (e1 < 0) { |
| 1882 e1 = -e1; | 2804 e1 = -e1; |
| 1883 if ((i = e1 & 15)) | 2805 if ((i = e1 & 15)) |
| 1884 » » » dval(rv) /= tens[i]; | 2806 » » » dval(&rv) /= tens[i]; |
| 1885 if (e1 >>= 4) { | 2807 if (e1 >>= 4) { |
| 1886 if (e1 >= 1 << n_bigtens) | 2808 if (e1 >= 1 << n_bigtens) |
| 1887 goto undfl; | 2809 goto undfl; |
| 1888 #ifdef Avoid_Underflow | 2810 #ifdef Avoid_Underflow |
| 1889 if (e1 & Scale_Bit) | 2811 if (e1 & Scale_Bit) |
| 1890 » » » » scale = 2*P; | 2812 » » » » bc.scale = 2*P; |
| 1891 for(j = 0; e1 > 0; j++, e1 >>= 1) | 2813 for(j = 0; e1 > 0; j++, e1 >>= 1) |
| 1892 if (e1 & 1) | 2814 if (e1 & 1) |
| 1893 » » » » » dval(rv) *= tinytens[j]; | 2815 » » » » » dval(&rv) *= tinytens[j]; |
| 1894 » » » if (scale && (j = 2*P + 1 - ((word0(rv) & Exp_mask) | 2816 » » » if (bc.scale && (j = 2*P + 1 - ((word0(&rv) & Exp_mask) |
| 1895 >> Exp_shift)) > 0) { | 2817 >> Exp_shift)) > 0) { |
| 1896 » » » » /* scaled rv is denormal; zap j low bits */ | 2818 » » » » /* scaled rv is denormal; clear j low bits */ |
| 1897 if (j >= 32) { | 2819 if (j >= 32) { |
| 1898 » » » » » word1(rv) = 0; | 2820 » » » » » word1(&rv) = 0; |
| 1899 if (j >= 53) | 2821 if (j >= 53) |
| 1900 » » » » » word0(rv) = (P+2)*Exp_msk1; | 2822 » » » » » word0(&rv) = (P+2)*Exp_msk1; |
| 1901 else | 2823 else |
| 1902 » » » » » word0(rv) &= 0xffffffff << (j-32); | 2824 » » » » » word0(&rv) &= 0xffffffff << (j-32); |
| 1903 } | 2825 } |
| 1904 else | 2826 else |
| 1905 » » » » » word1(rv) &= 0xffffffff << j; | 2827 » » » » » word1(&rv) &= 0xffffffff << j; |
| 1906 } | 2828 } |
| 1907 #else | 2829 #else |
| 1908 for(j = 0; e1 > 1; j++, e1 >>= 1) | 2830 for(j = 0; e1 > 1; j++, e1 >>= 1) |
| 1909 if (e1 & 1) | 2831 if (e1 & 1) |
| 1910 » » » » » dval(rv) *= tinytens[j]; | 2832 » » » » » dval(&rv) *= tinytens[j]; |
| 1911 /* The last multiplication could underflow. */ | 2833 /* The last multiplication could underflow. */ |
| 1912 » » » dval(rv0) = dval(rv); | 2834 » » » dval(&rv0) = dval(&rv); |
| 1913 » » » dval(rv) *= tinytens[j]; | 2835 » » » dval(&rv) *= tinytens[j]; |
| 1914 » » » if (!dval(rv)) { | 2836 » » » if (!dval(&rv)) { |
| 1915 » » » » dval(rv) = 2.*dval(rv0); | 2837 » » » » dval(&rv) = 2.*dval(&rv0); |
| 1916 » » » » dval(rv) *= tinytens[j]; | 2838 » » » » dval(&rv) *= tinytens[j]; |
| 1917 #endif | 2839 #endif |
| 1918 » » » » if (!dval(rv)) { | 2840 » » » » if (!dval(&rv)) { |
| 1919 undfl: | 2841 undfl: |
| 1920 » » » » » dval(rv) = 0.; | 2842 » » » » » dval(&rv) = 0.; |
| 1921 #ifndef NO_ERRNO | 2843 #ifndef NO_ERRNO |
| 1922 errno = ERANGE; | 2844 errno = ERANGE; |
| 1923 #endif | 2845 #endif |
| 1924 if (bd0) | |
| 1925 goto retfree; | |
| 1926 goto ret; | 2846 goto ret; |
| 1927 } | 2847 } |
| 1928 #ifndef Avoid_Underflow | 2848 #ifndef Avoid_Underflow |
| 1929 » » » » word0(rv) = Tiny0; | 2849 » » » » word0(&rv) = Tiny0; |
| 1930 » » » » word1(rv) = Tiny1; | 2850 » » » » word1(&rv) = Tiny1; |
| 1931 /* The refinement below will clean | 2851 /* The refinement below will clean |
| 1932 * this approximation up. | 2852 * this approximation up. |
| 1933 */ | 2853 */ |
| 1934 } | 2854 } |
| 1935 #endif | 2855 #endif |
| 1936 } | 2856 } |
| 1937 } | 2857 } |
| 1938 | 2858 |
| 1939 /* Now the hard part -- adjusting rv to the correct value.*/ | 2859 /* Now the hard part -- adjusting rv to the correct value.*/ |
| 1940 | 2860 |
| 1941 /* Put digits into bd: true value = bd * 10^e */ | 2861 /* Put digits into bd: true value = bd * 10^e */ |
| 1942 | 2862 |
| 1943 » bd0 = s2b(s0, nd0, nd, y); | 2863 » bc.nd = nd; |
| 2864 #ifndef NO_STRTOD_BIGCOMP |
| 2865 » bc.nd0 = nd0;» /* Only needed if nd > strtod_diglim, but done here */ |
| 2866 » » » /* to silence an erroneous warning about bc.nd0 */ |
| 2867 » » » /* possibly not being initialized. */ |
| 2868 » if (nd > strtod_diglim) { |
| 2869 » » /* ASSERT(strtod_diglim >= 18); 18 == one more than the */ |
| 2870 » » /* minimum number of decimal digits to distinguish double values
*/ |
| 2871 » » /* in IEEE arithmetic. */ |
| 2872 » » i = j = 18; |
| 2873 » » if (i > nd0) |
| 2874 » » » j += bc.dplen; |
| 2875 » » for(;;) { |
| 2876 » » » if (--j <= bc.dp1 && j >= bc.dp0) |
| 2877 » » » » j = bc.dp0 - 1; |
| 2878 » » » if (s0[j] != '0') |
| 2879 » » » » break; |
| 2880 » » » --i; |
| 2881 » » » } |
| 2882 » » e += nd - i; |
| 2883 » » nd = i; |
| 2884 » » if (nd0 > nd) |
| 2885 » » » nd0 = nd; |
| 2886 » » if (nd < 9) { /* must recompute y */ |
| 2887 » » » y = 0; |
| 2888 » » » for(i = 0; i < nd0; ++i) |
| 2889 » » » » y = 10*y + s0[i] - '0'; |
| 2890 » » » for(j = bc.dp1; i < nd; ++i) |
| 2891 » » » » y = 10*y + s0[j++] - '0'; |
| 2892 » » » } |
| 2893 » » } |
| 2894 #endif |
| 2895 » bd0 = s2b(s0, nd0, nd, y, bc.dplen); |
| 1944 | 2896 |
| 1945 for(;;) { | 2897 for(;;) { |
| 1946 bd = Balloc(bd0->k); | 2898 bd = Balloc(bd0->k); |
| 1947 Bcopy(bd, bd0); | 2899 Bcopy(bd, bd0); |
| 1948 » » bb = d2b(dval(rv), &bbe, &bbbits);» /* rv = bb * 2^bbe */ | 2900 » » bb = d2b(&rv, &bbe, &bbbits);» /* rv = bb * 2^bbe */ |
| 1949 bs = i2b(1); | 2901 bs = i2b(1); |
| 1950 | 2902 |
| 1951 if (e >= 0) { | 2903 if (e >= 0) { |
| 1952 bb2 = bb5 = 0; | 2904 bb2 = bb5 = 0; |
| 1953 bd2 = bd5 = e; | 2905 bd2 = bd5 = e; |
| 1954 } | 2906 } |
| 1955 else { | 2907 else { |
| 1956 bb2 = bb5 = -e; | 2908 bb2 = bb5 = -e; |
| 1957 bd2 = bd5 = 0; | 2909 bd2 = bd5 = 0; |
| 1958 } | 2910 } |
| 1959 if (bbe >= 0) | 2911 if (bbe >= 0) |
| 1960 bb2 += bbe; | 2912 bb2 += bbe; |
| 1961 else | 2913 else |
| 1962 bd2 -= bbe; | 2914 bd2 -= bbe; |
| 1963 bs2 = bb2; | 2915 bs2 = bb2; |
| 1964 #ifdef Honor_FLT_ROUNDS | 2916 #ifdef Honor_FLT_ROUNDS |
| 1965 » » if (rounding != 1) | 2917 » » if (bc.rounding != 1) |
| 1966 bs2++; | 2918 bs2++; |
| 1967 #endif | 2919 #endif |
| 1968 #ifdef Avoid_Underflow | 2920 #ifdef Avoid_Underflow |
| 1969 » » j = bbe - scale; | 2921 » » j = bbe - bc.scale; |
| 1970 i = j + bbbits - 1; /* logb(rv) */ | 2922 i = j + bbbits - 1; /* logb(rv) */ |
| 1971 if (i < Emin) /* denormal */ | 2923 if (i < Emin) /* denormal */ |
| 1972 j += P - Emin; | 2924 j += P - Emin; |
| 1973 else | 2925 else |
| 1974 j = P + 1 - bbbits; | 2926 j = P + 1 - bbbits; |
| 1975 #else /*Avoid_Underflow*/ | 2927 #else /*Avoid_Underflow*/ |
| 1976 #ifdef Sudden_Underflow | 2928 #ifdef Sudden_Underflow |
| 1977 #ifdef IBM | 2929 #ifdef IBM |
| 1978 j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3); | 2930 j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3); |
| 1979 #else | 2931 #else |
| 1980 j = P + 1 - bbbits; | 2932 j = P + 1 - bbbits; |
| 1981 #endif | 2933 #endif |
| 1982 #else /*Sudden_Underflow*/ | 2934 #else /*Sudden_Underflow*/ |
| 1983 j = bbe; | 2935 j = bbe; |
| 1984 i = j + bbbits - 1; /* logb(rv) */ | 2936 i = j + bbbits - 1; /* logb(rv) */ |
| 1985 if (i < Emin) /* denormal */ | 2937 if (i < Emin) /* denormal */ |
| 1986 j += P - Emin; | 2938 j += P - Emin; |
| 1987 else | 2939 else |
| 1988 j = P + 1 - bbbits; | 2940 j = P + 1 - bbbits; |
| 1989 #endif /*Sudden_Underflow*/ | 2941 #endif /*Sudden_Underflow*/ |
| 1990 #endif /*Avoid_Underflow*/ | 2942 #endif /*Avoid_Underflow*/ |
| 1991 bb2 += j; | 2943 bb2 += j; |
| 1992 bd2 += j; | 2944 bd2 += j; |
| 1993 #ifdef Avoid_Underflow | 2945 #ifdef Avoid_Underflow |
| 1994 » » bd2 += scale; | 2946 » » bd2 += bc.scale; |
| 1995 #endif | 2947 #endif |
| 1996 i = bb2 < bd2 ? bb2 : bd2; | 2948 i = bb2 < bd2 ? bb2 : bd2; |
| 1997 if (i > bs2) | 2949 if (i > bs2) |
| 1998 i = bs2; | 2950 i = bs2; |
| 1999 if (i > 0) { | 2951 if (i > 0) { |
| 2000 bb2 -= i; | 2952 bb2 -= i; |
| 2001 bd2 -= i; | 2953 bd2 -= i; |
| 2002 bs2 -= i; | 2954 bs2 -= i; |
| 2003 } | 2955 } |
| 2004 if (bb5 > 0) { | 2956 if (bb5 > 0) { |
| 2005 bs = pow5mult(bs, bb5); | 2957 bs = pow5mult(bs, bb5); |
| 2006 bb1 = mult(bs, bb); | 2958 bb1 = mult(bs, bb); |
| 2007 Bfree(bb); | 2959 Bfree(bb); |
| 2008 bb = bb1; | 2960 bb = bb1; |
| 2009 } | 2961 } |
| 2010 if (bb2 > 0) | 2962 if (bb2 > 0) |
| 2011 bb = lshift(bb, bb2); | 2963 bb = lshift(bb, bb2); |
| 2012 if (bd5 > 0) | 2964 if (bd5 > 0) |
| 2013 bd = pow5mult(bd, bd5); | 2965 bd = pow5mult(bd, bd5); |
| 2014 if (bd2 > 0) | 2966 if (bd2 > 0) |
| 2015 bd = lshift(bd, bd2); | 2967 bd = lshift(bd, bd2); |
| 2016 if (bs2 > 0) | 2968 if (bs2 > 0) |
| 2017 bs = lshift(bs, bs2); | 2969 bs = lshift(bs, bs2); |
| 2018 delta = diff(bb, bd); | 2970 delta = diff(bb, bd); |
| 2019 » » dsign = delta->sign; | 2971 » » bc.dsign = delta->sign; |
| 2020 delta->sign = 0; | 2972 delta->sign = 0; |
| 2021 i = cmp(delta, bs); | 2973 i = cmp(delta, bs); |
| 2974 #ifndef NO_STRTOD_BIGCOMP |
| 2975 if (bc.nd > nd && i <= 0) { |
| 2976 if (bc.dsign) |
| 2977 break; /* Must use bigcomp(). */ |
| 2022 #ifdef Honor_FLT_ROUNDS | 2978 #ifdef Honor_FLT_ROUNDS |
| 2023 » » if (rounding != 1) { | 2979 » » » if (bc.rounding != 1) { |
| 2980 » » » » if (i < 0) |
| 2981 » » » » » break; |
| 2982 » » » » } |
| 2983 » » » else |
| 2984 #endif |
| 2985 » » » » { |
| 2986 » » » » bc.nd = nd; |
| 2987 » » » » i = -1;»/* Discarded digits make delta smaller.
*/ |
| 2988 » » » » } |
| 2989 » » » } |
| 2990 #endif |
| 2991 #ifdef Honor_FLT_ROUNDS |
| 2992 » » if (bc.rounding != 1) { |
| 2024 if (i < 0) { | 2993 if (i < 0) { |
| 2025 /* Error is less than an ulp */ | 2994 /* Error is less than an ulp */ |
| 2026 if (!delta->x[0] && delta->wds <= 1) { | 2995 if (!delta->x[0] && delta->wds <= 1) { |
| 2027 /* exact */ | 2996 /* exact */ |
| 2028 #ifdef SET_INEXACT | 2997 #ifdef SET_INEXACT |
| 2029 » » » » » inexact = 0; | 2998 » » » » » bc.inexact = 0; |
| 2030 #endif | 2999 #endif |
| 2031 break; | 3000 break; |
| 2032 } | 3001 } |
| 2033 » » » » if (rounding) { | 3002 » » » » if (bc.rounding) { |
| 2034 » » » » » if (dsign) { | 3003 » » » » » if (bc.dsign) { |
| 2035 » » » » » » adj = 1.; | 3004 » » » » » » adj.d = 1.; |
| 2036 goto apply_adj; | 3005 goto apply_adj; |
| 2037 } | 3006 } |
| 2038 } | 3007 } |
| 2039 » » » » else if (!dsign) { | 3008 » » » » else if (!bc.dsign) { |
| 2040 » » » » » adj = -1.; | 3009 » » » » » adj.d = -1.; |
| 2041 » » » » » if (!word1(rv) | 3010 » » » » » if (!word1(&rv) |
| 2042 » » » » » && !(word0(rv) & Frac_mask)) { | 3011 » » » » » && !(word0(&rv) & Frac_mask)) { |
| 2043 » » » » » » y = word0(rv) & Exp_mask; | 3012 » » » » » » y = word0(&rv) & Exp_mask; |
| 2044 #ifdef Avoid_Underflow | 3013 #ifdef Avoid_Underflow |
| 2045 » » » » » » if (!scale || y > 2*P*Exp_msk1) | 3014 » » » » » » if (!bc.scale || y > 2*P*Exp_msk
1) |
| 2046 #else | 3015 #else |
| 2047 if (y) | 3016 if (y) |
| 2048 #endif | 3017 #endif |
| 2049 { | 3018 { |
| 2050 delta = lshift(delta,Log2P); | 3019 delta = lshift(delta,Log2P); |
| 2051 if (cmp(delta, bs) <= 0) | 3020 if (cmp(delta, bs) <= 0) |
| 2052 » » » » » » » adj = -0.5; | 3021 » » » » » » » adj.d = -0.5; |
| 2053 } | 3022 } |
| 2054 } | 3023 } |
| 2055 apply_adj: | 3024 apply_adj: |
| 2056 #ifdef Avoid_Underflow | 3025 #ifdef Avoid_Underflow |
| 2057 » » » » » if (scale && (y = word0(rv) & Exp_mask) | 3026 » » » » » if (bc.scale && (y = word0(&rv) & Exp_ma
sk) |
| 2058 <= 2*P*Exp_msk1) | 3027 <= 2*P*Exp_msk1) |
| 2059 » » » » » word0(adj) += (2*P+1)*Exp_msk1 - y; | 3028 » » » » » word0(&adj) += (2*P+1)*Exp_msk1 - y; |
| 2060 #else | 3029 #else |
| 2061 #ifdef Sudden_Underflow | 3030 #ifdef Sudden_Underflow |
| 2062 » » » » » if ((word0(rv) & Exp_mask) <= | 3031 » » » » » if ((word0(&rv) & Exp_mask) <= |
| 2063 P*Exp_msk1) { | 3032 P*Exp_msk1) { |
| 2064 » » » » » » word0(rv) += P*Exp_msk1; | 3033 » » » » » » word0(&rv) += P*Exp_msk1; |
| 2065 » » » » » » dval(rv) += adj*ulp(dval(rv)); | 3034 » » » » » » dval(&rv) += adj.d*ulp(dval(&rv)
); |
| 2066 » » » » » » word0(rv) -= P*Exp_msk1; | 3035 » » » » » » word0(&rv) -= P*Exp_msk1; |
| 2067 } | 3036 } |
| 2068 else | 3037 else |
| 2069 #endif /*Sudden_Underflow*/ | 3038 #endif /*Sudden_Underflow*/ |
| 2070 #endif /*Avoid_Underflow*/ | 3039 #endif /*Avoid_Underflow*/ |
| 2071 » » » » » dval(rv) += adj*ulp(dval(rv)); | 3040 » » » » » dval(&rv) += adj.d*ulp(&rv); |
| 2072 } | 3041 } |
| 2073 break; | 3042 break; |
| 2074 } | 3043 } |
| 2075 » » » adj = ratio(delta, bs); | 3044 » » » adj.d = ratio(delta, bs); |
| 2076 » » » if (adj < 1.) | 3045 » » » if (adj.d < 1.) |
| 2077 » » » » adj = 1.; | 3046 » » » » adj.d = 1.; |
| 2078 » » » if (adj <= 0x7ffffffe) { | 3047 » » » if (adj.d <= 0x7ffffffe) { |
| 2079 /* adj = rounding ? ceil(adj) : floor(adj); */ | 3048 /* adj = rounding ? ceil(adj) : floor(adj); */ |
| 2080 » » » » y = adj; | 3049 » » » » y = adj.d; |
| 2081 » » » » if (y != adj) { | 3050 » » » » if (y != adj.d) { |
| 2082 » » » » » if (!((rounding>>1) ^ dsign)) | 3051 » » » » » if (!((bc.rounding>>1) ^ bc.dsign)) |
| 2083 y++; | 3052 y++; |
| 2084 » » » » » adj = y; | 3053 » » » » » adj.d = y; |
| 2085 } | 3054 } |
| 2086 } | 3055 } |
| 2087 #ifdef Avoid_Underflow | 3056 #ifdef Avoid_Underflow |
| 2088 » » » if (scale && (y = word0(rv) & Exp_mask) <= 2*P*Exp_msk1) | 3057 » » » if (bc.scale && (y = word0(&rv) & Exp_mask) <= 2*P*Exp_m
sk1) |
| 2089 » » » » word0(adj) += (2*P+1)*Exp_msk1 - y; | 3058 » » » » word0(&adj) += (2*P+1)*Exp_msk1 - y; |
| 2090 #else | 3059 #else |
| 2091 #ifdef Sudden_Underflow | 3060 #ifdef Sudden_Underflow |
| 2092 » » » if ((word0(rv) & Exp_mask) <= P*Exp_msk1) { | 3061 » » » if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) { |
| 2093 » » » » word0(rv) += P*Exp_msk1; | 3062 » » » » word0(&rv) += P*Exp_msk1; |
| 2094 » » » » adj *= ulp(dval(rv)); | 3063 » » » » adj.d *= ulp(dval(&rv)); |
| 2095 » » » » if (dsign) | 3064 » » » » if (bc.dsign) |
| 2096 » » » » » dval(rv) += adj; | 3065 » » » » » dval(&rv) += adj.d; |
| 2097 else | 3066 else |
| 2098 » » » » » dval(rv) -= adj; | 3067 » » » » » dval(&rv) -= adj.d; |
| 2099 » » » » word0(rv) -= P*Exp_msk1; | 3068 » » » » word0(&rv) -= P*Exp_msk1; |
| 2100 goto cont; | 3069 goto cont; |
| 2101 } | 3070 } |
| 2102 #endif /*Sudden_Underflow*/ | 3071 #endif /*Sudden_Underflow*/ |
| 2103 #endif /*Avoid_Underflow*/ | 3072 #endif /*Avoid_Underflow*/ |
| 2104 » » » adj *= ulp(dval(rv)); | 3073 » » » adj.d *= ulp(&rv); |
| 2105 » » » if (dsign) | 3074 » » » if (bc.dsign) { |
| 2106 » » » » dval(rv) += adj; | 3075 » » » » if (word0(&rv) == Big0 && word1(&rv) == Big1) |
| 3076 » » » » » goto ovfl; |
| 3077 » » » » dval(&rv) += adj.d; |
| 3078 » » » » } |
| 2107 else | 3079 else |
| 2108 » » » » dval(rv) -= adj; | 3080 » » » » dval(&rv) -= adj.d; |
| 2109 goto cont; | 3081 goto cont; |
| 2110 } | 3082 } |
| 2111 #endif /*Honor_FLT_ROUNDS*/ | 3083 #endif /*Honor_FLT_ROUNDS*/ |
| 2112 | 3084 |
| 2113 if (i < 0) { | 3085 if (i < 0) { |
| 2114 /* Error is less than half an ulp -- check for | 3086 /* Error is less than half an ulp -- check for |
| 2115 * special case of mantissa a power of two. | 3087 * special case of mantissa a power of two. |
| 2116 */ | 3088 */ |
| 2117 » » » if (dsign || word1(rv) || word0(rv) & Bndry_mask | 3089 » » » if (bc.dsign || word1(&rv) || word0(&rv) & Bndry_mask |
| 2118 #ifdef IEEE_Arith | 3090 #ifdef IEEE_Arith |
| 2119 #ifdef Avoid_Underflow | 3091 #ifdef Avoid_Underflow |
| 2120 » » » || (word0(rv) & Exp_mask) <= (2*P+1)*Exp_msk1 | 3092 » » » || (word0(&rv) & Exp_mask) <= (2*P+1)*Exp_msk1 |
| 2121 #else | 3093 #else |
| 2122 » » » || (word0(rv) & Exp_mask) <= Exp_msk1 | 3094 » » » || (word0(&rv) & Exp_mask) <= Exp_msk1 |
| 2123 #endif | 3095 #endif |
| 2124 #endif | 3096 #endif |
| 2125 ) { | 3097 ) { |
| 2126 #ifdef SET_INEXACT | 3098 #ifdef SET_INEXACT |
| 2127 if (!delta->x[0] && delta->wds <= 1) | 3099 if (!delta->x[0] && delta->wds <= 1) |
| 2128 » » » » » inexact = 0; | 3100 » » » » » bc.inexact = 0; |
| 2129 #endif | 3101 #endif |
| 2130 break; | 3102 break; |
| 2131 } | 3103 } |
| 2132 if (!delta->x[0] && delta->wds <= 1) { | 3104 if (!delta->x[0] && delta->wds <= 1) { |
| 2133 /* exact result */ | 3105 /* exact result */ |
| 2134 #ifdef SET_INEXACT | 3106 #ifdef SET_INEXACT |
| 2135 » » » » inexact = 0; | 3107 » » » » bc.inexact = 0; |
| 2136 #endif | 3108 #endif |
| 2137 break; | 3109 break; |
| 2138 } | 3110 } |
| 2139 delta = lshift(delta,Log2P); | 3111 delta = lshift(delta,Log2P); |
| 2140 if (cmp(delta, bs) > 0) | 3112 if (cmp(delta, bs) > 0) |
| 2141 goto drop_down; | 3113 goto drop_down; |
| 2142 break; | 3114 break; |
| 2143 } | 3115 } |
| 2144 if (i == 0) { | 3116 if (i == 0) { |
| 2145 /* exactly half-way between */ | 3117 /* exactly half-way between */ |
| 2146 » » » if (dsign) { | 3118 » » » if (bc.dsign) { |
| 2147 » » » » if ((word0(rv) & Bndry_mask1) == Bndry_mask1 | 3119 » » » » if ((word0(&rv) & Bndry_mask1) == Bndry_mask1 |
| 2148 » » » » && word1(rv) == ( | 3120 » » » » && word1(&rv) == ( |
| 2149 #ifdef Avoid_Underflow | 3121 #ifdef Avoid_Underflow |
| 2150 » » » (scale && (y = word0(rv) & Exp_mask) <= 2*P*Exp_msk1) | 3122 » » » (bc.scale && (y = word0(&rv) & Exp_mask) <= 2*P*Exp_msk1
) |
| 2151 ? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) : | 3123 ? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) : |
| 2152 #endif | 3124 #endif |
| 2153 0xffffffff)) { | 3125 0xffffffff)) { |
| 2154 /*boundary case -- increment exponent*/ | 3126 /*boundary case -- increment exponent*/ |
| 2155 » » » » » word0(rv) = (word0(rv) & Exp_mask) | 3127 » » » » » word0(&rv) = (word0(&rv) & Exp_mask) |
| 2156 + Exp_msk1 | 3128 + Exp_msk1 |
| 2157 #ifdef IBM | 3129 #ifdef IBM |
| 2158 | Exp_msk1 >> 4 | 3130 | Exp_msk1 >> 4 |
| 2159 #endif | 3131 #endif |
| 2160 ; | 3132 ; |
| 2161 » » » » » word1(rv) = 0; | 3133 » » » » » word1(&rv) = 0; |
| 2162 #ifdef Avoid_Underflow | 3134 #ifdef Avoid_Underflow |
| 2163 » » » » » dsign = 0; | 3135 » » » » » bc.dsign = 0; |
| 2164 #endif | 3136 #endif |
| 2165 break; | 3137 break; |
| 2166 } | 3138 } |
| 2167 } | 3139 } |
| 2168 » » » else if (!(word0(rv) & Bndry_mask) && !word1(rv)) { | 3140 » » » else if (!(word0(&rv) & Bndry_mask) && !word1(&rv)) { |
| 2169 drop_down: | 3141 drop_down: |
| 2170 /* boundary case -- decrement exponent */ | 3142 /* boundary case -- decrement exponent */ |
| 2171 #ifdef Sudden_Underflow /*{{*/ | 3143 #ifdef Sudden_Underflow /*{{*/ |
| 2172 » » » » L = word0(rv) & Exp_mask; | 3144 » » » » L = word0(&rv) & Exp_mask; |
| 2173 #ifdef IBM | 3145 #ifdef IBM |
| 2174 if (L < Exp_msk1) | 3146 if (L < Exp_msk1) |
| 2175 #else | 3147 #else |
| 2176 #ifdef Avoid_Underflow | 3148 #ifdef Avoid_Underflow |
| 2177 » » » » if (L <= (scale ? (2*P+1)*Exp_msk1 : Exp_msk1)) | 3149 » » » » if (L <= (bc.scale ? (2*P+1)*Exp_msk1 : Exp_msk1
)) |
| 2178 #else | 3150 #else |
| 2179 if (L <= Exp_msk1) | 3151 if (L <= Exp_msk1) |
| 2180 #endif /*Avoid_Underflow*/ | 3152 #endif /*Avoid_Underflow*/ |
| 2181 #endif /*IBM*/ | 3153 #endif /*IBM*/ |
| 3154 { |
| 3155 if (bc.nd >nd) { |
| 3156 bc.uflchk = 1; |
| 3157 break; |
| 3158 } |
| 2182 goto undfl; | 3159 goto undfl; |
| 3160 } |
| 2183 L -= Exp_msk1; | 3161 L -= Exp_msk1; |
| 2184 #else /*Sudden_Underflow}{*/ | 3162 #else /*Sudden_Underflow}{*/ |
| 2185 #ifdef Avoid_Underflow | 3163 #ifdef Avoid_Underflow |
| 2186 » » » » if (scale) { | 3164 » » » » if (bc.scale) { |
| 2187 » » » » » L = word0(rv) & Exp_mask; | 3165 » » » » » L = word0(&rv) & Exp_mask; |
| 2188 if (L <= (2*P+1)*Exp_msk1) { | 3166 if (L <= (2*P+1)*Exp_msk1) { |
| 2189 if (L > (P+2)*Exp_msk1) | 3167 if (L > (P+2)*Exp_msk1) |
| 2190 /* round even ==> */ | 3168 /* round even ==> */ |
| 2191 /* accept rv */ | 3169 /* accept rv */ |
| 2192 break; | 3170 break; |
| 2193 /* rv = smallest denormal */ | 3171 /* rv = smallest denormal */ |
| 3172 if (bc.nd >nd) { |
| 3173 bc.uflchk = 1; |
| 3174 break; |
| 3175 } |
| 2194 goto undfl; | 3176 goto undfl; |
| 2195 } | 3177 } |
| 2196 } | 3178 } |
| 2197 #endif /*Avoid_Underflow*/ | 3179 #endif /*Avoid_Underflow*/ |
| 2198 » » » » L = (word0(rv) & Exp_mask) - Exp_msk1; | 3180 » » » » L = (word0(&rv) & Exp_mask) - Exp_msk1; |
| 2199 #endif /*Sudden_Underflow}}*/ | 3181 #endif /*Sudden_Underflow}}*/ |
| 2200 » » » » word0(rv) = L | Bndry_mask1; | 3182 » » » » word0(&rv) = L | Bndry_mask1; |
| 2201 » » » » word1(rv) = 0xffffffff; | 3183 » » » » word1(&rv) = 0xffffffff; |
| 2202 #ifdef IBM | 3184 #ifdef IBM |
| 2203 goto cont; | 3185 goto cont; |
| 2204 #else | 3186 #else |
| 2205 break; | 3187 break; |
| 2206 #endif | 3188 #endif |
| 2207 } | 3189 } |
| 2208 #ifndef ROUND_BIASED | 3190 #ifndef ROUND_BIASED |
| 2209 » » » if (!(word1(rv) & LSB)) | 3191 » » » if (!(word1(&rv) & LSB)) |
| 2210 break; | 3192 break; |
| 2211 #endif | 3193 #endif |
| 2212 » » » if (dsign) | 3194 » » » if (bc.dsign) |
| 2213 » » » » dval(rv) += ulp(dval(rv)); | 3195 » » » » dval(&rv) += ulp(&rv); |
| 2214 #ifndef ROUND_BIASED | 3196 #ifndef ROUND_BIASED |
| 2215 else { | 3197 else { |
| 2216 » » » » dval(rv) -= ulp(dval(rv)); | 3198 » » » » dval(&rv) -= ulp(&rv); |
| 2217 #ifndef Sudden_Underflow | 3199 #ifndef Sudden_Underflow |
| 2218 » » » » if (!dval(rv)) | 3200 » » » » if (!dval(&rv)) { |
| 3201 » » » » » if (bc.nd >nd) { |
| 3202 » » » » » » bc.uflchk = 1; |
| 3203 » » » » » » break; |
| 3204 » » » » » » } |
| 2219 goto undfl; | 3205 goto undfl; |
| 3206 } |
| 2220 #endif | 3207 #endif |
| 2221 } | 3208 } |
| 2222 #ifdef Avoid_Underflow | 3209 #ifdef Avoid_Underflow |
| 2223 » » » dsign = 1 - dsign; | 3210 » » » bc.dsign = 1 - bc.dsign; |
| 2224 #endif | 3211 #endif |
| 2225 #endif | 3212 #endif |
| 2226 break; | 3213 break; |
| 2227 } | 3214 } |
| 2228 if ((aadj = ratio(delta, bs)) <= 2.) { | 3215 if ((aadj = ratio(delta, bs)) <= 2.) { |
| 2229 » » » if (dsign) | 3216 » » » if (bc.dsign) |
| 2230 aadj = aadj1 = 1.; | 3217 aadj = aadj1 = 1.; |
| 2231 » » » else if (word1(rv) || word0(rv) & Bndry_mask) { | 3218 » » » else if (word1(&rv) || word0(&rv) & Bndry_mask) { |
| 2232 #ifndef Sudden_Underflow | 3219 #ifndef Sudden_Underflow |
| 2233 » » » » if (word1(rv) == Tiny1 && !word0(rv)) | 3220 » » » » if (word1(&rv) == Tiny1 && !word0(&rv)) { |
| 3221 » » » » » if (bc.nd >nd) { |
| 3222 » » » » » » bc.uflchk = 1; |
| 3223 » » » » » » break; |
| 3224 » » » » » » } |
| 2234 goto undfl; | 3225 goto undfl; |
| 3226 } |
| 2235 #endif | 3227 #endif |
| 2236 aadj = 1.; | 3228 aadj = 1.; |
| 2237 aadj1 = -1.; | 3229 aadj1 = -1.; |
| 2238 } | 3230 } |
| 2239 else { | 3231 else { |
| 2240 /* special case -- power of FLT_RADIX to be */ | 3232 /* special case -- power of FLT_RADIX to be */ |
| 2241 /* rounded down... */ | 3233 /* rounded down... */ |
| 2242 | 3234 |
| 2243 if (aadj < 2./FLT_RADIX) | 3235 if (aadj < 2./FLT_RADIX) |
| 2244 aadj = 1./FLT_RADIX; | 3236 aadj = 1./FLT_RADIX; |
| 2245 else | 3237 else |
| 2246 aadj *= 0.5; | 3238 aadj *= 0.5; |
| 2247 aadj1 = -aadj; | 3239 aadj1 = -aadj; |
| 2248 } | 3240 } |
| 2249 } | 3241 } |
| 2250 else { | 3242 else { |
| 2251 aadj *= 0.5; | 3243 aadj *= 0.5; |
| 2252 » » » aadj1 = dsign ? aadj : -aadj; | 3244 » » » aadj1 = bc.dsign ? aadj : -aadj; |
| 2253 #ifdef Check_FLT_ROUNDS | 3245 #ifdef Check_FLT_ROUNDS |
| 2254 » » » switch(Rounding) { | 3246 » » » switch(bc.rounding) { |
| 2255 case 2: /* towards +infinity */ | 3247 case 2: /* towards +infinity */ |
| 2256 aadj1 -= 0.5; | 3248 aadj1 -= 0.5; |
| 2257 break; | 3249 break; |
| 2258 case 0: /* towards 0 */ | 3250 case 0: /* towards 0 */ |
| 2259 case 3: /* towards -infinity */ | 3251 case 3: /* towards -infinity */ |
| 2260 aadj1 += 0.5; | 3252 aadj1 += 0.5; |
| 2261 } | 3253 } |
| 2262 #else | 3254 #else |
| 2263 if (Flt_Rounds == 0) | 3255 if (Flt_Rounds == 0) |
| 2264 aadj1 += 0.5; | 3256 aadj1 += 0.5; |
| 2265 #endif /*Check_FLT_ROUNDS*/ | 3257 #endif /*Check_FLT_ROUNDS*/ |
| 2266 } | 3258 } |
| 2267 » » y = word0(rv) & Exp_mask; | 3259 » » y = word0(&rv) & Exp_mask; |
| 2268 | 3260 |
| 2269 /* Check for overflow */ | 3261 /* Check for overflow */ |
| 2270 | 3262 |
| 2271 if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) { | 3263 if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) { |
| 2272 » » » dval(rv0) = dval(rv); | 3264 » » » dval(&rv0) = dval(&rv); |
| 2273 » » » word0(rv) -= P*Exp_msk1; | 3265 » » » word0(&rv) -= P*Exp_msk1; |
| 2274 » » » adj = aadj1 * ulp(dval(rv)); | 3266 » » » adj.d = aadj1 * ulp(&rv); |
| 2275 » » » dval(rv) += adj; | 3267 » » » dval(&rv) += adj.d; |
| 2276 » » » if ((word0(rv) & Exp_mask) >= | 3268 » » » if ((word0(&rv) & Exp_mask) >= |
| 2277 Exp_msk1*(DBL_MAX_EXP+Bias-P)) { | 3269 Exp_msk1*(DBL_MAX_EXP+Bias-P)) { |
| 2278 » » » » if (word0(rv0) == Big0 && word1(rv0) == Big1) | 3270 » » » » if (word0(&rv0) == Big0 && word1(&rv0) == Big1) |
| 2279 goto ovfl; | 3271 goto ovfl; |
| 2280 » » » » word0(rv) = Big0; | 3272 » » » » word0(&rv) = Big0; |
| 2281 » » » » word1(rv) = Big1; | 3273 » » » » word1(&rv) = Big1; |
| 2282 goto cont; | 3274 goto cont; |
| 2283 } | 3275 } |
| 2284 else | 3276 else |
| 2285 » » » » word0(rv) += P*Exp_msk1; | 3277 » » » » word0(&rv) += P*Exp_msk1; |
| 2286 } | 3278 } |
| 2287 else { | 3279 else { |
| 2288 #ifdef Avoid_Underflow | 3280 #ifdef Avoid_Underflow |
| 2289 » » » if (scale && y <= 2*P*Exp_msk1) { | 3281 » » » if (bc.scale && y <= 2*P*Exp_msk1) { |
| 2290 if (aadj <= 0x7fffffff) { | 3282 if (aadj <= 0x7fffffff) { |
| 2291 if ((z = aadj) <= 0) | 3283 if ((z = aadj) <= 0) |
| 2292 z = 1; | 3284 z = 1; |
| 2293 aadj = z; | 3285 aadj = z; |
| 2294 » » » » » aadj1 = dsign ? aadj : -aadj; | 3286 » » » » » aadj1 = bc.dsign ? aadj : -aadj; |
| 2295 } | 3287 } |
| 2296 » » » » word0(aadj1) += (2*P+1)*Exp_msk1 - y; | 3288 » » » » dval(&aadj2) = aadj1; |
| 3289 » » » » word0(&aadj2) += (2*P+1)*Exp_msk1 - y; |
| 3290 » » » » aadj1 = dval(&aadj2); |
| 2297 } | 3291 } |
| 2298 » » » adj = aadj1 * ulp(dval(rv)); | 3292 » » » adj.d = aadj1 * ulp(&rv); |
| 2299 » » » dval(rv) += adj; | 3293 » » » dval(&rv) += adj.d; |
| 2300 #else | 3294 #else |
| 2301 #ifdef Sudden_Underflow | 3295 #ifdef Sudden_Underflow |
| 2302 » » » if ((word0(rv) & Exp_mask) <= P*Exp_msk1) { | 3296 » » » if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) { |
| 2303 » » » » dval(rv0) = dval(rv); | 3297 » » » » dval(&rv0) = dval(&rv); |
| 2304 » » » » word0(rv) += P*Exp_msk1; | 3298 » » » » word0(&rv) += P*Exp_msk1; |
| 2305 » » » » adj = aadj1 * ulp(dval(rv)); | 3299 » » » » adj.d = aadj1 * ulp(&rv); |
| 2306 » » » » dval(rv) += adj; | 3300 » » » » dval(&rv) += adj.d; |
| 2307 #ifdef IBM | 3301 #ifdef IBM |
| 2308 » » » » if ((word0(rv) & Exp_mask) < P*Exp_msk1) | 3302 » » » » if ((word0(&rv) & Exp_mask) < P*Exp_msk1) |
| 2309 #else | 3303 #else |
| 2310 » » » » if ((word0(rv) & Exp_mask) <= P*Exp_msk1) | 3304 » » » » if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) |
| 2311 #endif | 3305 #endif |
| 2312 { | 3306 { |
| 2313 » » » » » if (word0(rv0) == Tiny0 | 3307 » » » » » if (word0(&rv0) == Tiny0 |
| 2314 » » » » » && word1(rv0) == Tiny1) | 3308 » » » » » && word1(&rv0) == Tiny1) { |
| 3309 » » » » » » if (bc.nd >nd) { |
| 3310 » » » » » » » bc.uflchk = 1; |
| 3311 » » » » » » » break; |
| 3312 » » » » » » » } |
| 2315 goto undfl; | 3313 goto undfl; |
| 2316 » » » » » word0(rv) = Tiny0; | 3314 » » » » » » } |
| 2317 » » » » » word1(rv) = Tiny1; | 3315 » » » » » word0(&rv) = Tiny0; |
| 3316 » » » » » word1(&rv) = Tiny1; |
| 2318 goto cont; | 3317 goto cont; |
| 2319 } | 3318 } |
| 2320 else | 3319 else |
| 2321 » » » » » word0(rv) -= P*Exp_msk1; | 3320 » » » » » word0(&rv) -= P*Exp_msk1; |
| 2322 } | 3321 } |
| 2323 else { | 3322 else { |
| 2324 » » » » adj = aadj1 * ulp(dval(rv)); | 3323 » » » » adj.d = aadj1 * ulp(&rv); |
| 2325 » » » » dval(rv) += adj; | 3324 » » » » dval(&rv) += adj.d; |
| 2326 } | 3325 } |
| 2327 #else /*Sudden_Underflow*/ | 3326 #else /*Sudden_Underflow*/ |
| 2328 /* Compute adj so that the IEEE rounding rules will | 3327 /* Compute adj so that the IEEE rounding rules will |
| 2329 * correctly round rv + adj in some half-way cases. | 3328 * correctly round rv + adj in some half-way cases. |
| 2330 * If rv * ulp(rv) is denormalized (i.e., | 3329 * If rv * ulp(rv) is denormalized (i.e., |
| 2331 * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid | 3330 * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid |
| 2332 * trouble from bits lost to denormalization; | 3331 * trouble from bits lost to denormalization; |
| 2333 * example: 1.2e-307 . | 3332 * example: 1.2e-307 . |
| 2334 */ | 3333 */ |
| 2335 if (y <= (P-1)*Exp_msk1 && aadj > 1.) { | 3334 if (y <= (P-1)*Exp_msk1 && aadj > 1.) { |
| 2336 aadj1 = (double)(int)(aadj + 0.5); | 3335 aadj1 = (double)(int)(aadj + 0.5); |
| 2337 » » » » if (!dsign) | 3336 » » » » if (!bc.dsign) |
| 2338 aadj1 = -aadj1; | 3337 aadj1 = -aadj1; |
| 2339 } | 3338 } |
| 2340 » » » adj = aadj1 * ulp(dval(rv)); | 3339 » » » adj.d = aadj1 * ulp(&rv); |
| 2341 » » » dval(rv) += adj; | 3340 » » » dval(&rv) += adj.d; |
| 2342 #endif /*Sudden_Underflow*/ | 3341 #endif /*Sudden_Underflow*/ |
| 2343 #endif /*Avoid_Underflow*/ | 3342 #endif /*Avoid_Underflow*/ |
| 2344 } | 3343 } |
| 2345 » » z = word0(rv) & Exp_mask; | 3344 » » z = word0(&rv) & Exp_mask; |
| 2346 #ifndef SET_INEXACT | 3345 #ifndef SET_INEXACT |
| 3346 if (bc.nd == nd) { |
| 2347 #ifdef Avoid_Underflow | 3347 #ifdef Avoid_Underflow |
| 2348 » » if (!scale) | 3348 » » if (!bc.scale) |
| 2349 #endif | 3349 #endif |
| 2350 if (y == z) { | 3350 if (y == z) { |
| 2351 /* Can we stop now? */ | 3351 /* Can we stop now? */ |
| 2352 L = (Long)aadj; | 3352 L = (Long)aadj; |
| 2353 aadj -= L; | 3353 aadj -= L; |
| 2354 /* The tolerances below are conservative. */ | 3354 /* The tolerances below are conservative. */ |
| 2355 » » » if (dsign || word1(rv) || word0(rv) & Bndry_mask) { | 3355 » » » if (bc.dsign || word1(&rv) || word0(&rv) & Bndry_mask) { |
| 2356 if (aadj < .4999999 || aadj > .5000001) | 3356 if (aadj < .4999999 || aadj > .5000001) |
| 2357 break; | 3357 break; |
| 2358 } | 3358 } |
| 2359 else if (aadj < .4999999/FLT_RADIX) | 3359 else if (aadj < .4999999/FLT_RADIX) |
| 2360 break; | 3360 break; |
| 2361 } | 3361 } |
| 3362 } |
| 2362 #endif | 3363 #endif |
| 2363 cont: | 3364 cont: |
| 2364 Bfree(bb); | 3365 Bfree(bb); |
| 2365 Bfree(bd); | 3366 Bfree(bd); |
| 2366 Bfree(bs); | 3367 Bfree(bs); |
| 2367 Bfree(delta); | 3368 Bfree(delta); |
| 2368 } | 3369 } |
| 3370 Bfree(bb); |
| 3371 Bfree(bd); |
| 3372 Bfree(bs); |
| 3373 Bfree(bd0); |
| 3374 Bfree(delta); |
| 3375 #ifndef NO_STRTOD_BIGCOMP |
| 3376 if (bc.nd > nd) |
| 3377 bigcomp(&rv, s0, &bc); |
| 3378 #endif |
| 2369 #ifdef SET_INEXACT | 3379 #ifdef SET_INEXACT |
| 2370 » if (inexact) { | 3380 » if (bc.inexact) { |
| 2371 if (!oldinexact) { | 3381 if (!oldinexact) { |
| 2372 » » » word0(rv0) = Exp_1 + (70 << Exp_shift); | 3382 » » » word0(&rv0) = Exp_1 + (70 << Exp_shift); |
| 2373 » » » word1(rv0) = 0; | 3383 » » » word1(&rv0) = 0; |
| 2374 » » » dval(rv0) += 1.; | 3384 » » » dval(&rv0) += 1.; |
| 2375 } | 3385 } |
| 2376 } | 3386 } |
| 2377 else if (!oldinexact) | 3387 else if (!oldinexact) |
| 2378 clear_inexact(); | 3388 clear_inexact(); |
| 2379 #endif | 3389 #endif |
| 2380 #ifdef Avoid_Underflow | 3390 #ifdef Avoid_Underflow |
| 2381 » if (scale) { | 3391 » if (bc.scale) { |
| 2382 » » word0(rv0) = Exp_1 - 2*P*Exp_msk1; | 3392 » » word0(&rv0) = Exp_1 - 2*P*Exp_msk1; |
| 2383 » » word1(rv0) = 0; | 3393 » » word1(&rv0) = 0; |
| 2384 » » dval(rv) *= dval(rv0); | 3394 » » dval(&rv) *= dval(&rv0); |
| 2385 #ifndef NO_ERRNO | 3395 #ifndef NO_ERRNO |
| 2386 /* try to avoid the bug of testing an 8087 register value */ | 3396 /* try to avoid the bug of testing an 8087 register value */ |
| 2387 » » if (word0(rv) == 0 && word1(rv) == 0) | 3397 #ifdef IEEE_Arith |
| 3398 » » if (!(word0(&rv) & Exp_mask)) |
| 3399 #else |
| 3400 » » if (word0(&rv) == 0 && word1(&rv) == 0) |
| 3401 #endif |
| 2388 errno = ERANGE; | 3402 errno = ERANGE; |
| 2389 #endif | 3403 #endif |
| 2390 } | 3404 } |
| 2391 #endif /* Avoid_Underflow */ | 3405 #endif /* Avoid_Underflow */ |
| 2392 #ifdef SET_INEXACT | 3406 #ifdef SET_INEXACT |
| 2393 » if (inexact && !(word0(rv) & Exp_mask)) { | 3407 » if (bc.inexact && !(word0(&rv) & Exp_mask)) { |
| 2394 /* set underflow bit */ | 3408 /* set underflow bit */ |
| 2395 » » dval(rv0) = 1e-300; | 3409 » » dval(&rv0) = 1e-300; |
| 2396 » » dval(rv0) *= dval(rv0); | 3410 » » dval(&rv0) *= dval(&rv0); |
| 2397 } | 3411 } |
| 2398 #endif | 3412 #endif |
| 2399 retfree: | |
| 2400 Bfree(bb); | |
| 2401 Bfree(bd); | |
| 2402 Bfree(bs); | |
| 2403 Bfree(bd0); | |
| 2404 Bfree(delta); | |
| 2405 ret: | 3413 ret: |
| 2406 if (se) | 3414 if (se) |
| 2407 *se = (char *)s; | 3415 *se = (char *)s; |
| 2408 » return sign ? -dval(rv) : dval(rv); | 3416 » return sign ? -dval(&rv) : dval(&rv); |
| 2409 » } | |
| 2410 | |
| 2411 static int | |
| 2412 quorem | |
| 2413 #ifdef KR_headers | |
| 2414 » (b, S) Bigint *b, *S; | |
| 2415 #else | |
| 2416 » (Bigint *b, Bigint *S) | |
| 2417 #endif | |
| 2418 { | |
| 2419 » int n; | |
| 2420 » ULong *bx, *bxe, q, *sx, *sxe; | |
| 2421 #ifdef ULLong | |
| 2422 » ULLong borrow, carry, y, ys; | |
| 2423 #else | |
| 2424 » ULong borrow, carry, y, ys; | |
| 2425 #ifdef Pack_32 | |
| 2426 » ULong si, z, zs; | |
| 2427 #endif | |
| 2428 #endif | |
| 2429 | |
| 2430 » n = S->wds; | |
| 2431 #ifdef DEBUG | |
| 2432 » /*debug*/ if (b->wds > n) | |
| 2433 » /*debug*/» Bug("oversize b in quorem"); | |
| 2434 #endif | |
| 2435 » if (b->wds < n) | |
| 2436 » » return 0; | |
| 2437 » sx = S->x; | |
| 2438 » sxe = sx + --n; | |
| 2439 » bx = b->x; | |
| 2440 » bxe = bx + n; | |
| 2441 » q = *bxe / (*sxe + 1);» /* ensure q <= true quotient */ | |
| 2442 #ifdef DEBUG | |
| 2443 » /*debug*/ if (q > 9) | |
| 2444 » /*debug*/» Bug("oversized quotient in quorem"); | |
| 2445 #endif | |
| 2446 » if (q) { | |
| 2447 » » borrow = 0; | |
| 2448 » » carry = 0; | |
| 2449 » » do { | |
| 2450 #ifdef ULLong | |
| 2451 » » » ys = *sx++ * (ULLong)q + carry; | |
| 2452 » » » carry = ys >> 32; | |
| 2453 » » » y = *bx - (ys & FFFFFFFF) - borrow; | |
| 2454 » » » borrow = y >> 32 & (ULong)1; | |
| 2455 » » » *bx++ = y & FFFFFFFF; | |
| 2456 #else | |
| 2457 #ifdef Pack_32 | |
| 2458 » » » si = *sx++; | |
| 2459 » » » ys = (si & 0xffff) * q + carry; | |
| 2460 » » » zs = (si >> 16) * q + (ys >> 16); | |
| 2461 » » » carry = zs >> 16; | |
| 2462 » » » y = (*bx & 0xffff) - (ys & 0xffff) - borrow; | |
| 2463 » » » borrow = (y & 0x10000) >> 16; | |
| 2464 » » » z = (*bx >> 16) - (zs & 0xffff) - borrow; | |
| 2465 » » » borrow = (z & 0x10000) >> 16; | |
| 2466 » » » Storeinc(bx, z, y); | |
| 2467 #else | |
| 2468 » » » ys = *sx++ * q + carry; | |
| 2469 » » » carry = ys >> 16; | |
| 2470 » » » y = *bx - (ys & 0xffff) - borrow; | |
| 2471 » » » borrow = (y & 0x10000) >> 16; | |
| 2472 » » » *bx++ = y & 0xffff; | |
| 2473 #endif | |
| 2474 #endif | |
| 2475 » » » } | |
| 2476 » » » while(sx <= sxe); | |
| 2477 » » if (!*bxe) { | |
| 2478 » » » bx = b->x; | |
| 2479 » » » while(--bxe > bx && !*bxe) | |
| 2480 » » » » --n; | |
| 2481 » » » b->wds = n; | |
| 2482 » » » } | |
| 2483 » » } | |
| 2484 » if (cmp(b, S) >= 0) { | |
| 2485 » » q++; | |
| 2486 » » borrow = 0; | |
| 2487 » » carry = 0; | |
| 2488 » » bx = b->x; | |
| 2489 » » sx = S->x; | |
| 2490 » » do { | |
| 2491 #ifdef ULLong | |
| 2492 » » » ys = *sx++ + carry; | |
| 2493 » » » carry = ys >> 32; | |
| 2494 » » » y = *bx - (ys & FFFFFFFF) - borrow; | |
| 2495 » » » borrow = y >> 32 & (ULong)1; | |
| 2496 » » » *bx++ = y & FFFFFFFF; | |
| 2497 #else | |
| 2498 #ifdef Pack_32 | |
| 2499 » » » si = *sx++; | |
| 2500 » » » ys = (si & 0xffff) + carry; | |
| 2501 » » » zs = (si >> 16) + (ys >> 16); | |
| 2502 » » » carry = zs >> 16; | |
| 2503 » » » y = (*bx & 0xffff) - (ys & 0xffff) - borrow; | |
| 2504 » » » borrow = (y & 0x10000) >> 16; | |
| 2505 » » » z = (*bx >> 16) - (zs & 0xffff) - borrow; | |
| 2506 » » » borrow = (z & 0x10000) >> 16; | |
| 2507 » » » Storeinc(bx, z, y); | |
| 2508 #else | |
| 2509 » » » ys = *sx++ + carry; | |
| 2510 » » » carry = ys >> 16; | |
| 2511 » » » y = *bx - (ys & 0xffff) - borrow; | |
| 2512 » » » borrow = (y & 0x10000) >> 16; | |
| 2513 » » » *bx++ = y & 0xffff; | |
| 2514 #endif | |
| 2515 #endif | |
| 2516 » » » } | |
| 2517 » » » while(sx <= sxe); | |
| 2518 » » bx = b->x; | |
| 2519 » » bxe = bx + n; | |
| 2520 » » if (!*bxe) { | |
| 2521 » » » while(--bxe > bx && !*bxe) | |
| 2522 » » » » --n; | |
| 2523 » » » b->wds = n; | |
| 2524 » » » } | |
| 2525 » » } | |
| 2526 » return q; | |
| 2527 } | 3417 } |
| 2528 | 3418 |
| 2529 #ifndef MULTIPLE_THREADS | 3419 #ifndef MULTIPLE_THREADS |
| 2530 static char *dtoa_result; | 3420 static char *dtoa_result; |
| 2531 #endif | 3421 #endif |
| 2532 | 3422 |
| 2533 static char * | 3423 static char * |
| 2534 #ifdef KR_headers | 3424 #ifdef KR_headers |
| 2535 rv_alloc(i) int i; | 3425 rv_alloc(i) int i; |
| 2536 #else | 3426 #else |
| 2537 rv_alloc(int i) | 3427 rv_alloc(int i) |
| 2538 #endif | 3428 #endif |
| 2539 { | 3429 { |
| 2540 int j, k, *r; | 3430 int j, k, *r; |
| 2541 | 3431 |
| 2542 j = sizeof(ULong); | 3432 j = sizeof(ULong); |
| 2543 for(k = 0; | 3433 for(k = 0; |
| 2544 » » sizeof(Bigint) - sizeof(ULong) - sizeof(int) + j <= i; | 3434 » » sizeof(Bigint) - sizeof(ULong) - sizeof(int) + j <= (size_t)i; |
| 2545 j <<= 1) | 3435 j <<= 1) |
| 2546 k++; | 3436 k++; |
| 2547 r = (int*)Balloc(k); | 3437 r = (int*)Balloc(k); |
| 2548 *r = k; | 3438 *r = k; |
| 2549 return | 3439 return |
| 2550 #ifndef MULTIPLE_THREADS | 3440 #ifndef MULTIPLE_THREADS |
| 2551 dtoa_result = | 3441 dtoa_result = |
| 2552 #endif | 3442 #endif |
| 2553 (char *)(r+1); | 3443 (char *)(r+1); |
| 2554 } | 3444 } |
| 2555 | 3445 |
| 2556 static char * | 3446 static char * |
| 2557 #ifdef KR_headers | 3447 #ifdef KR_headers |
| 2558 nrv_alloc(s, rve, n) char *s, **rve; int n; | 3448 nrv_alloc(s, rve, n) char *s, **rve; int n; |
| 2559 #else | 3449 #else |
| 2560 nrv_alloc(const char *s, char **rve, int n) | 3450 nrv_alloc(const char *s, char **rve, int n) |
| 2561 #endif | 3451 #endif |
| 2562 { | 3452 { |
| 2563 char *rv, *t; | 3453 char *rv, *t; |
| 2564 | 3454 |
| 2565 t = rv = rv_alloc(n); | 3455 t = rv = rv_alloc(n); |
| 2566 » while ((*t = *s++)) t++; | 3456 » while((*t = *s++)) t++; |
| 2567 if (rve) | 3457 if (rve) |
| 2568 *rve = t; | 3458 *rve = t; |
| 2569 return rv; | 3459 return rv; |
| 2570 } | 3460 } |
| 2571 | 3461 |
| 2572 /* freedtoa(s) must be used to free values s returned by dtoa | 3462 /* freedtoa(s) must be used to free values s returned by dtoa |
| 2573 * when MULTIPLE_THREADS is #defined. It should be used in all cases, | 3463 * when MULTIPLE_THREADS is #defined. It should be used in all cases, |
| 2574 * but for consistency with earlier versions of dtoa, it is optional | 3464 * but for consistency with earlier versions of dtoa, it is optional |
| 2575 * when MULTIPLE_THREADS is not defined. | 3465 * when MULTIPLE_THREADS is not defined. |
| 2576 */ | 3466 */ |
| (...skipping 44 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 2621 * guarantee that the floating-point calculation has given | 3511 * guarantee that the floating-point calculation has given |
| 2622 * the correctly rounded result. For k requested digits and | 3512 * the correctly rounded result. For k requested digits and |
| 2623 * "uniformly" distributed input, the probability is | 3513 * "uniformly" distributed input, the probability is |
| 2624 * something like 10^(k-15) that we must resort to the Long | 3514 * something like 10^(k-15) that we must resort to the Long |
| 2625 * calculation. | 3515 * calculation. |
| 2626 */ | 3516 */ |
| 2627 | 3517 |
| 2628 char * | 3518 char * |
| 2629 dtoa | 3519 dtoa |
| 2630 #ifdef KR_headers | 3520 #ifdef KR_headers |
| 2631 » (d, mode, ndigits, decpt, sign, rve) | 3521 » (dd, mode, ndigits, decpt, sign, rve) |
| 2632 » double d; int mode, ndigits, *decpt, *sign; char **rve; | 3522 » double dd; int mode, ndigits, *decpt, *sign; char **rve; |
| 2633 #else | 3523 #else |
| 2634 » (double d, int mode, int ndigits, int *decpt, int *sign, char **rve) | 3524 » (double dd, int mode, int ndigits, int *decpt, int *sign, char **rve) |
| 2635 #endif | 3525 #endif |
| 2636 { | 3526 { |
| 2637 /* Arguments ndigits, decpt, sign are similar to those | 3527 /* Arguments ndigits, decpt, sign are similar to those |
| 2638 of ecvt and fcvt; trailing zeros are suppressed from | 3528 of ecvt and fcvt; trailing zeros are suppressed from |
| 2639 the returned string. If not null, *rve is set to point | 3529 the returned string. If not null, *rve is set to point |
| 2640 to the end of the return value. If d is +-Infinity or NaN, | 3530 to the end of the return value. If d is +-Infinity or NaN, |
| 2641 then *decpt is set to 9999. | 3531 then *decpt is set to 9999. |
| 2642 | 3532 |
| 2643 mode: | 3533 mode: |
| 2644 0 ==> shortest string that yields d when read in | 3534 0 ==> shortest string that yields d when read in |
| (...skipping 25 matching lines...) Expand all Loading... |
| 2670 | 3560 |
| 2671 int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1, | 3561 int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1, |
| 2672 j, j1, k, k0, k_check, leftright, m2, m5, s2, s5, | 3562 j, j1, k, k0, k_check, leftright, m2, m5, s2, s5, |
| 2673 spec_case, try_quick, bias_round_up; | 3563 spec_case, try_quick, bias_round_up; |
| 2674 Long L; | 3564 Long L; |
| 2675 #ifndef Sudden_Underflow | 3565 #ifndef Sudden_Underflow |
| 2676 int denorm; | 3566 int denorm; |
| 2677 ULong x; | 3567 ULong x; |
| 2678 #endif | 3568 #endif |
| 2679 Bigint *b, *b1, *delta, *mlo, *mhi, *S; | 3569 Bigint *b, *b1, *delta, *mlo, *mhi, *S; |
| 2680 » double d2, ds, eps; | 3570 » U d2, eps, u; |
| 3571 » double ds; |
| 2681 char *s, *s0; | 3572 char *s, *s0; |
| 2682 #ifdef Honor_FLT_ROUNDS | |
| 2683 int rounding; | |
| 2684 #endif | |
| 2685 #ifdef SET_INEXACT | 3573 #ifdef SET_INEXACT |
| 2686 int inexact, oldinexact; | 3574 int inexact, oldinexact; |
| 2687 #endif | 3575 #endif |
| 3576 #ifdef Honor_FLT_ROUNDS /*{*/ |
| 3577 int Rounding; |
| 3578 #ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */ |
| 3579 Rounding = Flt_Rounds; |
| 3580 #else /*}{*/ |
| 3581 Rounding = 1; |
| 3582 switch(fegetround()) { |
| 3583 case FE_TOWARDZERO: Rounding = 0; break; |
| 3584 case FE_UPWARD: Rounding = 2; break; |
| 3585 case FE_DOWNWARD: Rounding = 3; |
| 3586 } |
| 3587 #endif /*}}*/ |
| 3588 #endif /*}*/ |
| 2688 | 3589 |
| 2689 /* In mode 2 and 3 we bias rounding up when there are ties. */ | 3590 /* In mode 2 and 3 we bias rounding up when there are ties. */ |
| 2690 bias_round_up = mode == 2 || mode == 3; | 3591 bias_round_up = mode == 2 || mode == 3; |
| 2691 | 3592 |
| 2692 ilim = ilim1 = 0; /* to avoid Google3 compiler warnings */ | 3593 ilim = ilim1 = 0; /* to avoid Google3 compiler warnings */ |
| 2693 | 3594 |
| 2694 #ifndef MULTIPLE_THREADS | 3595 #ifndef MULTIPLE_THREADS |
| 2695 if (dtoa_result) { | 3596 if (dtoa_result) { |
| 2696 freedtoa(dtoa_result); | 3597 freedtoa(dtoa_result); |
| 2697 dtoa_result = 0; | 3598 dtoa_result = 0; |
| 2698 } | 3599 } |
| 2699 #endif | 3600 #endif |
| 2700 | 3601 |
| 2701 » if (word0(d) & Sign_bit) { | 3602 » u.d = dd; |
| 3603 » if (word0(&u) & Sign_bit) { |
| 2702 /* set sign for everything, including 0's and NaNs */ | 3604 /* set sign for everything, including 0's and NaNs */ |
| 2703 *sign = 1; | 3605 *sign = 1; |
| 2704 » » word0(d) &= ~Sign_bit;» /* clear sign bit */ | 3606 » » word0(&u) &= ~Sign_bit;»/* clear sign bit */ |
| 2705 } | 3607 } |
| 2706 else | 3608 else |
| 2707 *sign = 0; | 3609 *sign = 0; |
| 2708 | 3610 |
| 2709 #if defined(IEEE_Arith) + defined(VAX) | 3611 #if defined(IEEE_Arith) + defined(VAX) |
| 2710 #ifdef IEEE_Arith | 3612 #ifdef IEEE_Arith |
| 2711 » if ((word0(d) & Exp_mask) == Exp_mask) | 3613 » if ((word0(&u) & Exp_mask) == Exp_mask) |
| 2712 #else | 3614 #else |
| 2713 » if (word0(d) == 0x8000) | 3615 » if (word0(&u) == 0x8000) |
| 2714 #endif | 3616 #endif |
| 2715 { | 3617 { |
| 2716 /* Infinity or NaN */ | 3618 /* Infinity or NaN */ |
| 2717 *decpt = 9999; | 3619 *decpt = 9999; |
| 2718 #ifdef IEEE_Arith | 3620 #ifdef IEEE_Arith |
| 2719 » » if (!word1(d) && !(word0(d) & 0xfffff)) | 3621 » » if (!word1(&u) && !(word0(&u) & 0xfffff)) |
| 2720 return nrv_alloc("Infinity", rve, 8); | 3622 return nrv_alloc("Infinity", rve, 8); |
| 2721 #endif | 3623 #endif |
| 2722 return nrv_alloc("NaN", rve, 3); | 3624 return nrv_alloc("NaN", rve, 3); |
| 2723 } | 3625 } |
| 2724 #endif | 3626 #endif |
| 2725 #ifdef IBM | 3627 #ifdef IBM |
| 2726 » dval(d) += 0; /* normalize */ | 3628 » dval(&u) += 0; /* normalize */ |
| 2727 #endif | 3629 #endif |
| 2728 » if (!dval(d)) { | 3630 » if (!dval(&u)) { |
| 2729 *decpt = 1; | 3631 *decpt = 1; |
| 2730 return nrv_alloc("0", rve, 1); | 3632 return nrv_alloc("0", rve, 1); |
| 2731 } | 3633 } |
| 2732 | 3634 |
| 2733 #ifdef SET_INEXACT | 3635 #ifdef SET_INEXACT |
| 2734 try_quick = oldinexact = get_inexact(); | 3636 try_quick = oldinexact = get_inexact(); |
| 2735 inexact = 1; | 3637 inexact = 1; |
| 2736 #endif | 3638 #endif |
| 2737 #ifdef Honor_FLT_ROUNDS | 3639 #ifdef Honor_FLT_ROUNDS |
| 2738 » if ((rounding = Flt_Rounds) >= 2) { | 3640 » if (Rounding >= 2) { |
| 2739 if (*sign) | 3641 if (*sign) |
| 2740 » » » rounding = rounding == 2 ? 0 : 2; | 3642 » » » Rounding = Rounding == 2 ? 0 : 2; |
| 2741 else | 3643 else |
| 2742 » » » if (rounding != 2) | 3644 » » » if (Rounding != 2) |
| 2743 » » » » rounding = 0; | 3645 » » » » Rounding = 0; |
| 2744 } | 3646 } |
| 2745 #endif | 3647 #endif |
| 2746 | 3648 |
| 2747 » b = d2b(dval(d), &be, &bbits); | 3649 » b = d2b(&u, &be, &bbits); |
| 2748 #ifdef Sudden_Underflow | 3650 #ifdef Sudden_Underflow |
| 2749 » i = (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1)); | 3651 » i = (int)(word0(&u) >> Exp_shift1 & (Exp_mask>>Exp_shift1)); |
| 2750 #else | 3652 #else |
| 2751 » if ((i = (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1)))) { | 3653 » if ((i = (int)(word0(&u) >> Exp_shift1 & (Exp_mask>>Exp_shift1)))) { |
| 2752 #endif | 3654 #endif |
| 2753 » » dval(d2) = dval(d); | 3655 » » dval(&d2) = dval(&u); |
| 2754 » » word0(d2) &= Frac_mask1; | 3656 » » word0(&d2) &= Frac_mask1; |
| 2755 » » word0(d2) |= Exp_11; | 3657 » » word0(&d2) |= Exp_11; |
| 2756 #ifdef IBM | 3658 #ifdef IBM |
| 2757 » » if (j = 11 - hi0bits(word0(d2) & Frac_mask)) | 3659 » » if (j = 11 - hi0bits(word0(&d2) & Frac_mask)) |
| 2758 » » » dval(d2) /= 1 << j; | 3660 » » » dval(&d2) /= 1 << j; |
| 2759 #endif | 3661 #endif |
| 2760 | 3662 |
| 2761 /* log(x) ~=~ log(1.5) + (x-1.5)/1.5 | 3663 /* log(x) ~=~ log(1.5) + (x-1.5)/1.5 |
| 2762 * log10(x) = log(x) / log(10) | 3664 * log10(x) = log(x) / log(10) |
| 2763 * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10)) | 3665 * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10)) |
| 2764 * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2) | 3666 * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2) |
| 2765 * | 3667 * |
| 2766 * This suggests computing an approximation k to log10(d) by | 3668 * This suggests computing an approximation k to log10(d) by |
| 2767 * | 3669 * |
| 2768 * k = (i - Bias)*0.301029995663981 | 3670 * k = (i - Bias)*0.301029995663981 |
| (...skipping 16 matching lines...) Expand all Loading... |
| 2785 i <<= 2; | 3687 i <<= 2; |
| 2786 i += j; | 3688 i += j; |
| 2787 #endif | 3689 #endif |
| 2788 #ifndef Sudden_Underflow | 3690 #ifndef Sudden_Underflow |
| 2789 denorm = 0; | 3691 denorm = 0; |
| 2790 } | 3692 } |
| 2791 else { | 3693 else { |
| 2792 /* d is denormalized */ | 3694 /* d is denormalized */ |
| 2793 | 3695 |
| 2794 i = bbits + be + (Bias + (P-1) - 1); | 3696 i = bbits + be + (Bias + (P-1) - 1); |
| 2795 » » x = i > 32 ? (word0(d) << (64 - i)) | (word1(d) >> (i - 32)) | 3697 » » x = i > 32 ? (word0(&u) << (64 - i)) | (word1(&u) >> (i - 32)) |
| 2796 » » » : word1(d) << (32 - i); | 3698 » » » : word1(&u) << (32 - i); |
| 2797 » » dval(d2) = x; | 3699 » » dval(&d2) = x; |
| 2798 » » word0(d2) -= 31*Exp_msk1; /* adjust exponent */ | 3700 » » word0(&d2) -= 31*Exp_msk1; /* adjust exponent */ |
| 2799 i -= (Bias + (P-1) - 1) + 1; | 3701 i -= (Bias + (P-1) - 1) + 1; |
| 2800 denorm = 1; | 3702 denorm = 1; |
| 2801 } | 3703 } |
| 2802 #endif | 3704 #endif |
| 2803 » ds = (dval(d2)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.3010299956
63981; | 3705 » ds = (dval(&d2)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995
663981; |
| 2804 k = (int)ds; | 3706 k = (int)ds; |
| 2805 if (ds < 0. && ds != k) | 3707 if (ds < 0. && ds != k) |
| 2806 k--; /* want k = floor(ds) */ | 3708 k--; /* want k = floor(ds) */ |
| 2807 k_check = 1; | 3709 k_check = 1; |
| 2808 if (k >= 0 && k <= Ten_pmax) { | 3710 if (k >= 0 && k <= Ten_pmax) { |
| 2809 » » if (dval(d) < tens[k]) | 3711 » » if (dval(&u) < tens[k]) |
| 2810 k--; | 3712 k--; |
| 2811 k_check = 0; | 3713 k_check = 0; |
| 2812 } | 3714 } |
| 2813 j = bbits - i - 1; | 3715 j = bbits - i - 1; |
| 2814 if (j >= 0) { | 3716 if (j >= 0) { |
| 2815 b2 = 0; | 3717 b2 = 0; |
| 2816 s2 = j; | 3718 s2 = j; |
| 2817 } | 3719 } |
| 2818 else { | 3720 else { |
| 2819 b2 = -j; | 3721 b2 = -j; |
| (...skipping 18 matching lines...) Expand all Loading... |
| 2838 #else | 3740 #else |
| 2839 try_quick = 1; | 3741 try_quick = 1; |
| 2840 #endif | 3742 #endif |
| 2841 #endif /*SET_INEXACT*/ | 3743 #endif /*SET_INEXACT*/ |
| 2842 | 3744 |
| 2843 if (mode > 5) { | 3745 if (mode > 5) { |
| 2844 mode -= 4; | 3746 mode -= 4; |
| 2845 try_quick = 0; | 3747 try_quick = 0; |
| 2846 } | 3748 } |
| 2847 leftright = 1; | 3749 leftright = 1; |
| 3750 ilim = ilim1 = -1; /* Values for cases 0 and 1; done here to */ |
| 3751 /* silence erroneous "gcc -Wall" warning. */ |
| 2848 switch(mode) { | 3752 switch(mode) { |
| 2849 case 0: | 3753 case 0: |
| 2850 case 1: | 3754 case 1: |
| 2851 ilim = ilim1 = -1; | |
| 2852 i = 18; | 3755 i = 18; |
| 2853 ndigits = 0; | 3756 ndigits = 0; |
| 2854 break; | 3757 break; |
| 2855 case 2: | 3758 case 2: |
| 2856 leftright = 0; | 3759 leftright = 0; |
| 2857 /* no break */ | 3760 /* no break */ |
| 2858 case 4: | 3761 case 4: |
| 2859 if (ndigits <= 0) | 3762 if (ndigits <= 0) |
| 2860 ndigits = 1; | 3763 ndigits = 1; |
| 2861 ilim = ilim1 = i = ndigits; | 3764 ilim = ilim1 = i = ndigits; |
| 2862 break; | 3765 break; |
| 2863 case 3: | 3766 case 3: |
| 2864 leftright = 0; | 3767 leftright = 0; |
| 2865 /* no break */ | 3768 /* no break */ |
| 2866 case 5: | 3769 case 5: |
| 2867 i = ndigits + k + 1; | 3770 i = ndigits + k + 1; |
| 2868 ilim = i; | 3771 ilim = i; |
| 2869 ilim1 = i - 1; | 3772 ilim1 = i - 1; |
| 2870 if (i <= 0) | 3773 if (i <= 0) |
| 2871 i = 1; | 3774 i = 1; |
| 2872 } | 3775 } |
| 2873 s = s0 = rv_alloc(i); | 3776 s = s0 = rv_alloc(i); |
| 2874 | 3777 |
| 2875 #ifdef Honor_FLT_ROUNDS | 3778 #ifdef Honor_FLT_ROUNDS |
| 2876 » if (mode > 1 && rounding != 1) | 3779 » if (mode > 1 && Rounding != 1) |
| 2877 leftright = 0; | 3780 leftright = 0; |
| 2878 #endif | 3781 #endif |
| 2879 | 3782 |
| 2880 if (ilim >= 0 && ilim <= Quick_max && try_quick) { | 3783 if (ilim >= 0 && ilim <= Quick_max && try_quick) { |
| 2881 | 3784 |
| 2882 /* Try to get by with floating-point arithmetic. */ | 3785 /* Try to get by with floating-point arithmetic. */ |
| 2883 | 3786 |
| 2884 i = 0; | 3787 i = 0; |
| 2885 » » dval(d2) = dval(d); | 3788 » » dval(&d2) = dval(&u); |
| 2886 k0 = k; | 3789 k0 = k; |
| 2887 ilim0 = ilim; | 3790 ilim0 = ilim; |
| 2888 ieps = 2; /* conservative */ | 3791 ieps = 2; /* conservative */ |
| 2889 if (k > 0) { | 3792 if (k > 0) { |
| 2890 ds = tens[k&0xf]; | 3793 ds = tens[k&0xf]; |
| 2891 j = k >> 4; | 3794 j = k >> 4; |
| 2892 if (j & Bletch) { | 3795 if (j & Bletch) { |
| 2893 /* prevent overflows */ | 3796 /* prevent overflows */ |
| 2894 j &= Bletch - 1; | 3797 j &= Bletch - 1; |
| 2895 » » » » dval(d) /= bigtens[n_bigtens-1]; | 3798 » » » » dval(&u) /= bigtens[n_bigtens-1]; |
| 2896 ieps++; | 3799 ieps++; |
| 2897 } | 3800 } |
| 2898 for(; j; j >>= 1, i++) | 3801 for(; j; j >>= 1, i++) |
| 2899 if (j & 1) { | 3802 if (j & 1) { |
| 2900 ieps++; | 3803 ieps++; |
| 2901 ds *= bigtens[i]; | 3804 ds *= bigtens[i]; |
| 2902 } | 3805 } |
| 2903 » » » dval(d) /= ds; | 3806 » » » dval(&u) /= ds; |
| 2904 } | 3807 } |
| 2905 else if ((j1 = -k)) { | 3808 else if ((j1 = -k)) { |
| 2906 » » » dval(d) *= tens[j1 & 0xf]; | 3809 » » » dval(&u) *= tens[j1 & 0xf]; |
| 2907 for(j = j1 >> 4; j; j >>= 1, i++) | 3810 for(j = j1 >> 4; j; j >>= 1, i++) |
| 2908 if (j & 1) { | 3811 if (j & 1) { |
| 2909 ieps++; | 3812 ieps++; |
| 2910 » » » » » dval(d) *= bigtens[i]; | 3813 » » » » » dval(&u) *= bigtens[i]; |
| 2911 } | 3814 } |
| 2912 } | 3815 } |
| 2913 » » if (k_check && dval(d) < 1. && ilim > 0) { | 3816 » » if (k_check && dval(&u) < 1. && ilim > 0) { |
| 2914 if (ilim1 <= 0) | 3817 if (ilim1 <= 0) |
| 2915 goto fast_failed; | 3818 goto fast_failed; |
| 2916 ilim = ilim1; | 3819 ilim = ilim1; |
| 2917 k--; | 3820 k--; |
| 2918 » » » dval(d) *= 10.; | 3821 » » » dval(&u) *= 10.; |
| 2919 ieps++; | 3822 ieps++; |
| 2920 } | 3823 } |
| 2921 » » dval(eps) = ieps*dval(d) + 7.; | 3824 » » dval(&eps) = ieps*dval(&u) + 7.; |
| 2922 » » word0(eps) -= (P-1)*Exp_msk1; | 3825 » » word0(&eps) -= (P-1)*Exp_msk1; |
| 2923 if (ilim == 0) { | 3826 if (ilim == 0) { |
| 2924 S = mhi = 0; | 3827 S = mhi = 0; |
| 2925 » » » dval(d) -= 5.; | 3828 » » » dval(&u) -= 5.; |
| 2926 » » » if (dval(d) > dval(eps)) | 3829 » » » if (dval(&u) > dval(&eps)) |
| 2927 goto one_digit; | 3830 goto one_digit; |
| 2928 » » » if (dval(d) < -dval(eps)) | 3831 » » » if (dval(&u) < -dval(&eps)) |
| 2929 goto no_digits; | 3832 goto no_digits; |
| 2930 goto fast_failed; | 3833 goto fast_failed; |
| 2931 } | 3834 } |
| 2932 #ifndef No_leftright | 3835 #ifndef No_leftright |
| 2933 if (leftright) { | 3836 if (leftright) { |
| 2934 /* Use Steele & White method of only | 3837 /* Use Steele & White method of only |
| 2935 * generating digits needed. | 3838 * generating digits needed. |
| 2936 */ | 3839 */ |
| 2937 » » » dval(eps) = 0.5/tens[ilim-1] - dval(eps); | 3840 » » » dval(&eps) = 0.5/tens[ilim-1] - dval(&eps); |
| 2938 for(i = 0;;) { | 3841 for(i = 0;;) { |
| 2939 » » » » L = dval(d); | 3842 » » » » L = dval(&u); |
| 2940 » » » » dval(d) -= L; | 3843 » » » » dval(&u) -= L; |
| 2941 *s++ = '0' + (int)L; | 3844 *s++ = '0' + (int)L; |
| 2942 » » » » if (dval(d) < dval(eps)) | 3845 » » » » if (dval(&u) < dval(&eps)) |
| 2943 goto ret1; | 3846 goto ret1; |
| 2944 » » » » if (1. - dval(d) < dval(eps)) | 3847 » » » » if (1. - dval(&u) < dval(&eps)) |
| 2945 goto bump_up; | 3848 goto bump_up; |
| 2946 if (++i >= ilim) | 3849 if (++i >= ilim) |
| 2947 break; | 3850 break; |
| 2948 » » » » dval(eps) *= 10.; | 3851 » » » » dval(&eps) *= 10.; |
| 2949 » » » » dval(d) *= 10.; | 3852 » » » » dval(&u) *= 10.; |
| 2950 } | 3853 } |
| 2951 } | 3854 } |
| 2952 else { | 3855 else { |
| 2953 #endif | 3856 #endif |
| 2954 /* Generate ilim digits, then fix them up. */ | 3857 /* Generate ilim digits, then fix them up. */ |
| 2955 » » » dval(eps) *= tens[ilim-1]; | 3858 » » » dval(&eps) *= tens[ilim-1]; |
| 2956 » » » for(i = 1;; i++, dval(d) *= 10.) { | 3859 » » » for(i = 1;; i++, dval(&u) *= 10.) { |
| 2957 » » » » L = (Long)(dval(d)); | 3860 » » » » L = (Long)(dval(&u)); |
| 2958 » » » » if (!(dval(d) -= L)) | 3861 » » » » if (!(dval(&u) -= L)) |
| 2959 ilim = i; | 3862 ilim = i; |
| 2960 *s++ = '0' + (int)L; | 3863 *s++ = '0' + (int)L; |
| 2961 if (i == ilim) { | 3864 if (i == ilim) { |
| 2962 » » » » » if (dval(d) > 0.5 + dval(eps)) | 3865 » » » » » if (dval(&u) > 0.5 + dval(&eps)) |
| 2963 goto bump_up; | 3866 goto bump_up; |
| 2964 » » » » » else if (dval(d) < 0.5 - dval(eps)) { | 3867 » » » » » else if (dval(&u) < 0.5 - dval(&eps)) { |
| 2965 while(*--s == '0'); | 3868 while(*--s == '0'); |
| 2966 s++; | 3869 s++; |
| 2967 goto ret1; | 3870 goto ret1; |
| 2968 } | 3871 } |
| 2969 break; | 3872 break; |
| 2970 } | 3873 } |
| 2971 } | 3874 } |
| 2972 #ifndef No_leftright | 3875 #ifndef No_leftright |
| 2973 } | 3876 } |
| 2974 #endif | 3877 #endif |
| 2975 fast_failed: | 3878 fast_failed: |
| 2976 s = s0; | 3879 s = s0; |
| 2977 » » dval(d) = dval(d2); | 3880 » » dval(&u) = dval(&d2); |
| 2978 k = k0; | 3881 k = k0; |
| 2979 ilim = ilim0; | 3882 ilim = ilim0; |
| 2980 } | 3883 } |
| 2981 | 3884 |
| 2982 /* Do we have a "small" integer? */ | 3885 /* Do we have a "small" integer? */ |
| 2983 | 3886 |
| 2984 if (be >= 0 && k <= Int_max) { | 3887 if (be >= 0 && k <= Int_max) { |
| 2985 /* Yes. */ | 3888 /* Yes. */ |
| 2986 ds = tens[k]; | 3889 ds = tens[k]; |
| 2987 if (ndigits < 0 && ilim <= 0) { | 3890 if (ndigits < 0 && ilim <= 0) { |
| 2988 S = mhi = 0; | 3891 S = mhi = 0; |
| 2989 » » » if (ilim < 0 || dval(d) < 5*ds || ((dval(d) == 5*ds) &&
!bias_round_up)) | 3892 » » » if (ilim < 0 || dval(&u) <= 5*ds) |
| 3893 » » » if (ilim < 0 || dval(&u) < 5*ds || ((dval(&u) == 5*ds) &
& !bias_round_up)) |
| 2990 goto no_digits; | 3894 goto no_digits; |
| 2991 goto one_digit; | 3895 goto one_digit; |
| 2992 } | 3896 } |
| 2993 | 3897 |
| 2994 /* Limit looping by the number of digits to produce. | 3898 /* Limit looping by the number of digits to produce. |
| 2995 * Firefox had a crash bug because some plugins reduce | 3899 * Firefox had a crash bug because some plugins reduce |
| 2996 * the precision of double arithmetic. With reduced | 3900 * the precision of double arithmetic. With reduced |
| 2997 * precision "dval(d) -= L*ds" might be imprecise and | 3901 * precision "dval(d) -= L*ds" might be imprecise and |
| 2998 * d might not become zero and the loop might not | 3902 * d might not become zero and the loop might not |
| 2999 * terminate. | 3903 * terminate. |
| 3000 * | 3904 * |
| 3001 * See https://bugzilla.mozilla.org/show_bug.cgi?id=358569 | 3905 * See https://bugzilla.mozilla.org/show_bug.cgi?id=358569 |
| 3002 */ | 3906 */ |
| 3003 » » for(i = 1; i <= k+1; i++, dval(d) *= 10.) { | 3907 » » for(i = 1; i <= k+1; i++, dval(&u) *= 10.) { |
| 3004 » » » L = (Long)(dval(d) / ds); | 3908 » » » L = (Long)(dval(&u) / ds); |
| 3005 » » » dval(d) -= L*ds; | 3909 » » » dval(&u) -= L*ds; |
| 3006 #ifdef Check_FLT_ROUNDS | 3910 #ifdef Check_FLT_ROUNDS |
| 3007 /* If FLT_ROUNDS == 2, L will usually be high by 1 */ | 3911 /* If FLT_ROUNDS == 2, L will usually be high by 1 */ |
| 3008 » » » if (dval(d) < 0) { | 3912 » » » if (dval(&u) < 0) { |
| 3009 L--; | 3913 L--; |
| 3010 » » » » dval(d) += ds; | 3914 » » » » dval(&u) += ds; |
| 3011 } | 3915 } |
| 3012 #endif | 3916 #endif |
| 3013 *s++ = '0' + (int)L; | 3917 *s++ = '0' + (int)L; |
| 3014 » » » if (!dval(d)) { | 3918 » » » if (!dval(&u)) { |
| 3015 #ifdef SET_INEXACT | 3919 #ifdef SET_INEXACT |
| 3016 inexact = 0; | 3920 inexact = 0; |
| 3017 #endif | 3921 #endif |
| 3018 break; | 3922 break; |
| 3019 } | 3923 } |
| 3020 if (i == ilim) { | 3924 if (i == ilim) { |
| 3021 #ifdef Honor_FLT_ROUNDS | 3925 #ifdef Honor_FLT_ROUNDS |
| 3022 if (mode > 1) | 3926 if (mode > 1) |
| 3023 » » » » switch(rounding) { | 3927 » » » » switch(Rounding) { |
| 3024 case 0: goto ret1; | 3928 case 0: goto ret1; |
| 3025 case 2: goto bump_up; | 3929 case 2: goto bump_up; |
| 3026 } | 3930 } |
| 3027 #endif | 3931 #endif |
| 3028 » » » » dval(d) += dval(d); | 3932 » » » » dval(&u) += dval(&u); |
| 3029 » » » » if (dval(d) > ds || (dval(d) == ds && ((L & 1) |
| bias_round_up))) { | 3933 » » » » if (dval(&u) > ds || (dval(&u) == ds && ((L & 1)
|| bias_round_up))) { |
| 3030 bump_up: | 3934 bump_up: |
| 3031 while(*--s == '9') | 3935 while(*--s == '9') |
| 3032 if (s == s0) { | 3936 if (s == s0) { |
| 3033 k++; | 3937 k++; |
| 3034 *s = '0'; | 3938 *s = '0'; |
| 3035 break; | 3939 break; |
| 3036 } | 3940 } |
| 3037 ++*s++; | 3941 ++*s++; |
| 3038 } | 3942 } |
| 3039 break; | 3943 break; |
| (...skipping 41 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 3081 } | 3985 } |
| 3082 S = i2b(1); | 3986 S = i2b(1); |
| 3083 if (s5 > 0) | 3987 if (s5 > 0) |
| 3084 S = pow5mult(S, s5); | 3988 S = pow5mult(S, s5); |
| 3085 | 3989 |
| 3086 /* Check for special case that d is a normalized power of 2. */ | 3990 /* Check for special case that d is a normalized power of 2. */ |
| 3087 | 3991 |
| 3088 spec_case = 0; | 3992 spec_case = 0; |
| 3089 if ((mode < 2 || leftright) | 3993 if ((mode < 2 || leftright) |
| 3090 #ifdef Honor_FLT_ROUNDS | 3994 #ifdef Honor_FLT_ROUNDS |
| 3091 » » » && rounding == 1 | 3995 » » » && Rounding == 1 |
| 3092 #endif | 3996 #endif |
| 3093 ) { | 3997 ) { |
| 3094 » » if (!word1(d) && !(word0(d) & Bndry_mask) | 3998 » » if (!word1(&u) && !(word0(&u) & Bndry_mask) |
| 3095 #ifndef Sudden_Underflow | 3999 #ifndef Sudden_Underflow |
| 3096 » » && word0(d) & (Exp_mask & ~Exp_msk1) | 4000 » » && word0(&u) & (Exp_mask & ~Exp_msk1) |
| 3097 #endif | 4001 #endif |
| 3098 ) { | 4002 ) { |
| 3099 /* The special case */ | 4003 /* The special case */ |
| 3100 b2 += Log2P; | 4004 b2 += Log2P; |
| 3101 s2 += Log2P; | 4005 s2 += Log2P; |
| 3102 spec_case = 1; | 4006 spec_case = 1; |
| 3103 } | 4007 } |
| 3104 } | 4008 } |
| 3105 | 4009 |
| 3106 /* Arrange for convenient computation of quotients: | 4010 /* Arrange for convenient computation of quotients: |
| 3107 * shift left if necessary so divisor has 4 leading 0 bits. | 4011 * shift left if necessary so divisor has 4 leading 0 bits. |
| 3108 * | 4012 * |
| 3109 * Perhaps we should just compute leading 28 bits of S once | 4013 * Perhaps we should just compute leading 28 bits of S once |
| 3110 * and for all and pass them and a shift to quorem, so it | 4014 * and for all and pass them and a shift to quorem, so it |
| 3111 * can do shifts and ors to compute the numerator for q. | 4015 * can do shifts and ors to compute the numerator for q. |
| 3112 */ | 4016 */ |
| 3113 #ifdef Pack_32 | 4017 #ifdef Pack_32 |
| 3114 if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f)) | 4018 if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f)) |
| 3115 i = 32 - i; | 4019 i = 32 - i; |
| 4020 #define iInc 28 |
| 3116 #else | 4021 #else |
| 3117 if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0xf)) | 4022 if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0xf)) |
| 3118 i = 16 - i; | 4023 i = 16 - i; |
| 4024 #define iInc 12 |
| 3119 #endif | 4025 #endif |
| 3120 » if (i > 4) { | 4026 » i = dshift(S, s2); |
| 3121 » » i -= 4; | 4027 » b2 += i; |
| 3122 » » b2 += i; | 4028 » m2 += i; |
| 3123 » » m2 += i; | 4029 » s2 += i; |
| 3124 » » s2 += i; | |
| 3125 » » } | |
| 3126 » else if (i < 4) { | |
| 3127 » » i += 28; | |
| 3128 » » b2 += i; | |
| 3129 » » m2 += i; | |
| 3130 » » s2 += i; | |
| 3131 » » } | |
| 3132 if (b2 > 0) | 4030 if (b2 > 0) |
| 3133 b = lshift(b, b2); | 4031 b = lshift(b, b2); |
| 3134 if (s2 > 0) | 4032 if (s2 > 0) |
| 3135 S = lshift(S, s2); | 4033 S = lshift(S, s2); |
| 3136 if (k_check) { | 4034 if (k_check) { |
| 3137 if (cmp(b,S) < 0) { | 4035 if (cmp(b,S) < 0) { |
| 3138 k--; | 4036 k--; |
| 3139 b = multadd(b, 10, 0); /* we botched the k estimate */ | 4037 b = multadd(b, 10, 0); /* we botched the k estimate */ |
| 3140 if (leftright) | 4038 if (leftright) |
| 3141 mhi = multadd(mhi, 10, 0); | 4039 mhi = multadd(mhi, 10, 0); |
| 3142 ilim = ilim1; | 4040 ilim = ilim1; |
| 3143 } | 4041 } |
| 3144 } | 4042 } |
| 3145 if (ilim <= 0 && (mode == 3 || mode == 5)) { | 4043 if (ilim <= 0 && (mode == 3 || mode == 5)) { |
| 3146 S = multadd(S, 5, 0); | 4044 » » if (ilim < 0 || cmp(b, S = multadd(S, 5, 0)) < 0 || ((cmp(b, S)
== 0) && !bias_round_up)) { |
| 3147 » » if (ilim < 0 || cmp(b, S) < 0 || ((cmp(b, S) == 0) && !bias_roun
d_up)) { | |
| 3148 /* no digits, fcvt style */ | 4045 /* no digits, fcvt style */ |
| 3149 no_digits: | 4046 no_digits: |
| 3150 k = -1 - ndigits; | 4047 k = -1 - ndigits; |
| 3151 goto ret; | 4048 goto ret; |
| 3152 } | 4049 } |
| 3153 one_digit: | 4050 one_digit: |
| 3154 *s++ = '1'; | 4051 *s++ = '1'; |
| 3155 k++; | 4052 k++; |
| 3156 goto ret; | 4053 goto ret; |
| 3157 } | 4054 } |
| (...skipping 15 matching lines...) Expand all Loading... |
| 3173 for(i = 1;;i++) { | 4070 for(i = 1;;i++) { |
| 3174 dig = quorem(b,S) + '0'; | 4071 dig = quorem(b,S) + '0'; |
| 3175 /* Do we yet have the shortest decimal string | 4072 /* Do we yet have the shortest decimal string |
| 3176 * that will round to d? | 4073 * that will round to d? |
| 3177 */ | 4074 */ |
| 3178 j = cmp(b, mlo); | 4075 j = cmp(b, mlo); |
| 3179 delta = diff(S, mhi); | 4076 delta = diff(S, mhi); |
| 3180 j1 = delta->sign ? 1 : cmp(b, delta); | 4077 j1 = delta->sign ? 1 : cmp(b, delta); |
| 3181 Bfree(delta); | 4078 Bfree(delta); |
| 3182 #ifndef ROUND_BIASED | 4079 #ifndef ROUND_BIASED |
| 3183 » » » if (j1 == 0 && mode != 1 && !(word1(d) & 1) | 4080 » » » if (j1 == 0 && mode != 1 && !(word1(&u) & 1) |
| 3184 #ifdef Honor_FLT_ROUNDS | 4081 #ifdef Honor_FLT_ROUNDS |
| 3185 » » » » && rounding >= 1 | 4082 » » » » && Rounding >= 1 |
| 3186 #endif | 4083 #endif |
| 3187 ) { | 4084 ) { |
| 3188 if (dig == '9') | 4085 if (dig == '9') |
| 3189 goto round_9_up; | 4086 goto round_9_up; |
| 3190 if (j > 0) | 4087 if (j > 0) |
| 3191 dig++; | 4088 dig++; |
| 3192 #ifdef SET_INEXACT | 4089 #ifdef SET_INEXACT |
| 3193 else if (!b->x[0] && b->wds <= 1) | 4090 else if (!b->x[0] && b->wds <= 1) |
| 3194 inexact = 0; | 4091 inexact = 0; |
| 3195 #endif | 4092 #endif |
| 3196 *s++ = dig; | 4093 *s++ = dig; |
| 3197 goto ret; | 4094 goto ret; |
| 3198 } | 4095 } |
| 3199 #endif | 4096 #endif |
| 3200 if (j < 0 || (j == 0 && mode != 1 | 4097 if (j < 0 || (j == 0 && mode != 1 |
| 3201 #ifndef ROUND_BIASED | 4098 #ifndef ROUND_BIASED |
| 3202 » » » » » » » && !(word1(d) & 1) | 4099 » » » » » » » && !(word1(&u) & 1) |
| 3203 #endif | 4100 #endif |
| 3204 )) { | 4101 )) { |
| 3205 if (!b->x[0] && b->wds <= 1) { | 4102 if (!b->x[0] && b->wds <= 1) { |
| 3206 #ifdef SET_INEXACT | 4103 #ifdef SET_INEXACT |
| 3207 inexact = 0; | 4104 inexact = 0; |
| 3208 #endif | 4105 #endif |
| 3209 goto accept_dig; | 4106 goto accept_dig; |
| 3210 } | 4107 } |
| 3211 #ifdef Honor_FLT_ROUNDS | 4108 #ifdef Honor_FLT_ROUNDS |
| 3212 if (mode > 1) | 4109 if (mode > 1) |
| 3213 » » » » switch(rounding) { | 4110 » » » » switch(Rounding) { |
| 3214 case 0: goto accept_dig; | 4111 case 0: goto accept_dig; |
| 3215 case 2: goto keep_dig; | 4112 case 2: goto keep_dig; |
| 3216 } | 4113 } |
| 3217 #endif /*Honor_FLT_ROUNDS*/ | 4114 #endif /*Honor_FLT_ROUNDS*/ |
| 3218 if (j1 > 0) { | 4115 if (j1 > 0) { |
| 3219 b = lshift(b, 1); | 4116 b = lshift(b, 1); |
| 3220 j1 = cmp(b, S); | 4117 j1 = cmp(b, S); |
| 3221 if ((j1 > 0 || (j1 == 0 && ((dig & 1) ||
bias_round_up))) | 4118 if ((j1 > 0 || (j1 == 0 && ((dig & 1) ||
bias_round_up))) |
| 3222 && dig++ == '9') | 4119 && dig++ == '9') |
| 3223 goto round_9_up; | 4120 goto round_9_up; |
| 3224 } | 4121 } |
| 3225 accept_dig: | 4122 accept_dig: |
| 3226 *s++ = dig; | 4123 *s++ = dig; |
| 3227 goto ret; | 4124 goto ret; |
| 3228 } | 4125 } |
| 3229 if (j1 > 0) { | 4126 if (j1 > 0) { |
| 3230 #ifdef Honor_FLT_ROUNDS | 4127 #ifdef Honor_FLT_ROUNDS |
| 3231 » » » » if (!rounding) | 4128 » » » » if (!Rounding) |
| 3232 goto accept_dig; | 4129 goto accept_dig; |
| 3233 #endif | 4130 #endif |
| 3234 if (dig == '9') { /* possible if i == 1 */ | 4131 if (dig == '9') { /* possible if i == 1 */ |
| 3235 round_9_up: | 4132 round_9_up: |
| 3236 *s++ = '9'; | 4133 *s++ = '9'; |
| 3237 goto roundoff; | 4134 goto roundoff; |
| 3238 } | 4135 } |
| 3239 *s++ = dig + 1; | 4136 *s++ = dig + 1; |
| 3240 goto ret; | 4137 goto ret; |
| 3241 } | 4138 } |
| (...skipping 22 matching lines...) Expand all Loading... |
| 3264 goto ret; | 4161 goto ret; |
| 3265 } | 4162 } |
| 3266 if (i >= ilim) | 4163 if (i >= ilim) |
| 3267 break; | 4164 break; |
| 3268 b = multadd(b, 10, 0); | 4165 b = multadd(b, 10, 0); |
| 3269 } | 4166 } |
| 3270 | 4167 |
| 3271 /* Round off last digit */ | 4168 /* Round off last digit */ |
| 3272 | 4169 |
| 3273 #ifdef Honor_FLT_ROUNDS | 4170 #ifdef Honor_FLT_ROUNDS |
| 3274 » switch(rounding) { | 4171 » switch(Rounding) { |
| 3275 case 0: goto trimzeros; | 4172 case 0: goto trimzeros; |
| 3276 case 2: goto roundoff; | 4173 case 2: goto roundoff; |
| 3277 } | 4174 } |
| 3278 #endif | 4175 #endif |
| 3279 b = lshift(b, 1); | 4176 b = lshift(b, 1); |
| 3280 j = cmp(b, S); | 4177 j = cmp(b, S); |
| 3281 if (j > 0 || (j == 0 && ((dig & 1) || bias_round_up))) { | 4178 if (j > 0 || (j == 0 && ((dig & 1) || bias_round_up))) { |
| 3282 roundoff: | 4179 roundoff: |
| 3283 while(*--s == '9') | 4180 while(*--s == '9') |
| 3284 if (s == s0) { | 4181 if (s == s0) { |
| 3285 k++; | 4182 k++; |
| 3286 *s++ = '1'; | 4183 *s++ = '1'; |
| 3287 goto ret; | 4184 goto ret; |
| 3288 } | 4185 } |
| 3289 ++*s++; | 4186 ++*s++; |
| 3290 } | 4187 } |
| 3291 else { | 4188 else { |
| 3292 /* trimzeros: (never used) */ | 4189 #ifdef Honor_FLT_ROUNDS |
| 4190 trimzeros: |
| 4191 #endif |
| 3293 while(*--s == '0'); | 4192 while(*--s == '0'); |
| 3294 s++; | 4193 s++; |
| 3295 } | 4194 } |
| 3296 ret: | 4195 ret: |
| 3297 Bfree(S); | 4196 Bfree(S); |
| 3298 if (mhi) { | 4197 if (mhi) { |
| 3299 if (mlo && mlo != mhi) | 4198 if (mlo && mlo != mhi) |
| 3300 Bfree(mlo); | 4199 Bfree(mlo); |
| 3301 Bfree(mhi); | 4200 Bfree(mhi); |
| 3302 } | 4201 } |
| 3303 ret1: | 4202 ret1: |
| 3304 #ifdef SET_INEXACT | 4203 #ifdef SET_INEXACT |
| 3305 if (inexact) { | 4204 if (inexact) { |
| 3306 if (!oldinexact) { | 4205 if (!oldinexact) { |
| 3307 » » » word0(d) = Exp_1 + (70 << Exp_shift); | 4206 » » » word0(&u) = Exp_1 + (70 << Exp_shift); |
| 3308 » » » word1(d) = 0; | 4207 » » » word1(&u) = 0; |
| 3309 » » » dval(d) += 1.; | 4208 » » » dval(&u) += 1.; |
| 3310 } | 4209 } |
| 3311 } | 4210 } |
| 3312 else if (!oldinexact) | 4211 else if (!oldinexact) |
| 3313 clear_inexact(); | 4212 clear_inexact(); |
| 3314 #endif | 4213 #endif |
| 3315 Bfree(b); | 4214 Bfree(b); |
| 3316 *s = 0; | 4215 *s = 0; |
| 3317 *decpt = k + 1; | 4216 *decpt = k + 1; |
| 3318 if (rve) | 4217 if (rve) |
| 3319 *rve = s; | 4218 *rve = s; |
| 3320 return s0; | 4219 return s0; |
| 3321 } | 4220 } |
| 3322 #ifdef __cplusplus | 4221 #ifdef __cplusplus |
| 3323 } | 4222 } |
| 3324 #endif | 4223 #endif |
| OLD | NEW |