15821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/**************************************************************** 25821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 35821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * The author of this software is David M. Gay. 45821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 55821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Copyright (c) 1991, 2000, 2001 by Lucent Technologies. 65821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 75821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Permission to use, copy, modify, and distribute this software for any 85821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * purpose without fee is hereby granted, provided that this entire notice 95821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * is included in all copies of any software which is or includes a copy 105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * or modification of this software and in all copies of the supporting 115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * documentation for such software. 125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED 145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * WARRANTY. IN PARTICULAR, NEITHER THE AUTHOR NOR LUCENT MAKES ANY 155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY 165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE. 175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ***************************************************************/ 195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* Please send bug reports to David M. Gay (dmg at acm dot org, 215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * with " at " changed at "@" and " dot " changed to "."). */ 225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* On a machine with IEEE extended-precision registers, it is 245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * necessary to specify double-precision (53-bit) rounding precision 255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * before invoking strtod or dtoa. If the machine uses (the equivalent 265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * of) Intel 80x87 arithmetic, the call 275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * _control87(PC_53, MCW_PC); 285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * does this with many compilers. Whether this or another call is 295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * appropriate depends on the compiler; for this to work, it may be 305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * necessary to #include "float.h" or another system-dependent header 315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * file. 325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* strtod for IEEE-, VAX-, and IBM-arithmetic machines. 355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * This strtod returns a nearest machine number to the input decimal 375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * string (or sets errno to ERANGE). With IEEE arithmetic, ties are 385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * broken by the IEEE round-even rule. Otherwise ties are broken by 395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * biased rounding (add half and chop). 405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Inspired loosely by William D. Clinger's paper "How to Read Floating 425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 92-101]. 435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Modifications: 455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 1. We only require IEEE, IBM, or VAX double-precision 475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * arithmetic (not IEEE double-extended). 485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 2. We get by with floating-point arithmetic in a case that 495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Clinger missed -- when we're computing d * 10^n 505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * for a small integer d and the integer n is not too 515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * much larger than 22 (the maximum integer k for which 525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * we can represent 10^k exactly), we may be able to 535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * compute (d*10^k) * 10^(e-k) with just one roundoff. 545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 3. Rather than a bit-at-a-time adjustment of the binary 555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * result in the hard case, we use floating-point 565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * arithmetic to determine the adjustment to within 575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * one bit; only in really hard cases do we need to 585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * compute a second residual. 595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 4. Because of 3., we don't need a large table of powers of 10 605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * for ten-to-e (just some small tables, e.g. of 10^k 615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * for 0 <= k <= 22). 625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* 655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define IEEE_8087 for IEEE-arithmetic machines where the least 665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * significant byte has the lowest address. 675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define IEEE_MC68k for IEEE-arithmetic machines where the most 685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * significant byte has the lowest address. 695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define Long int on machines with 32-bit ints and 64-bit longs. 705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define IBM for IBM mainframe-style floating-point arithmetic. 715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define VAX for VAX-style floating-point arithmetic (D_floating). 725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define No_leftright to omit left-right logic in fast floating-point 735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * computation of dtoa. 745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define Honor_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3 755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * and strtod and dtoa should round accordingly. Unless Trust_FLT_ROUNDS 765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * is also #defined, fegetround() will be queried for the rounding mode. 775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Note that both FLT_ROUNDS and fegetround() are specified by the C99 785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * standard (and are specified to be consistent, with fesetround() 795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * affecting the value of FLT_ROUNDS), but that some (Linux) systems 805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * do not work correctly in this regard, so using fegetround() is more 815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * portable than using FLT_FOUNDS directly. 825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3 835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * and Honor_FLT_ROUNDS is not #defined. 845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines 855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * that use extended-precision instructions to compute rounded 865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * products and quotients) with IBM. 875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define ROUND_BIASED for IEEE-format with biased rounding. 885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define Inaccurate_Divide for IEEE-format with correctly rounded 895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * products but inaccurate quotients, e.g., for Intel i860. 905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define NO_LONG_LONG on machines that do not have a "long long" 915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * integer type (of >= 64 bits). On such machines, you can 925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define Just_16 to store 16 bits per 32-bit Long when doing 935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * high-precision integer arithmetic. Whether this speeds things 945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * up or slows things down depends on the machine and the number 955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * being converted. If long long is available and the name is 965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * something other than "long long", #define Llong to be the name, 975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * and if "unsigned Llong" does not work as an unsigned version of 985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Llong, #define #ULLong to be the corresponding unsigned type. 995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define KR_headers for old-style C function headers. 1005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define Bad_float_h if your system lacks a float.h or if it does not 1015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * define some or all of DBL_DIG, DBL_MAX_10_EXP, DBL_MAX_EXP, 1025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * FLT_RADIX, FLT_ROUNDS, and DBL_MAX. 1035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define MALLOC your_malloc, where your_malloc(n) acts like malloc(n) 1045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * if memory is available and otherwise does something you deem 1055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * appropriate. If MALLOC is undefined, malloc will be invoked 1065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * directly -- and assumed always to succeed. Similarly, if you 1075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * want something other than the system's free() to be called to 1085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * recycle memory acquired from MALLOC, #define FREE to be the 1095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * name of the alternate routine. (FREE or free is only called in 1105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * pathological cases, e.g., in a dtoa call after a dtoa return in 1115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * mode 3 with thousands of digits requested.) 1125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define Omit_Private_Memory to omit logic (added Jan. 1998) for making 1135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * memory allocations from a private pool of memory when possible. 1145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * When used, the private pool is PRIVATE_MEM bytes long: 2304 bytes, 1155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * unless #defined to be a different length. This default length 1165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * suffices to get rid of MALLOC calls except for unusual cases, 1175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * such as decimal-to-binary conversion of a very long string of 1185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * digits. The longest string dtoa can return is about 751 bytes 1195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * long. For conversions by strtod of strings of 800 digits and 1205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * all dtoa conversions in single-threaded executions with 8-byte 1215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * pointers, PRIVATE_MEM >= 7400 appears to suffice; with 4-byte 1225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * pointers, PRIVATE_MEM >= 7112 appears adequate. 1235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define NO_INFNAN_CHECK if you do not wish to have INFNAN_CHECK 1245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #defined automatically on IEEE systems. On such systems, 1255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * when INFNAN_CHECK is #defined, strtod checks 1265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * for Infinity and NaN (case insensitively). On some systems 1275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * (e.g., some HP systems), it may be necessary to #define NAN_WORD0 1285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * appropriately -- to the most significant word of a quiet NaN. 1295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * (On HP Series 700/800 machines, -DNAN_WORD0=0x7ff40000 works.) 1305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * When INFNAN_CHECK is #defined and No_Hex_NaN is not #defined, 1315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * strtod also accepts (case insensitively) strings of the form 1325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * NaN(x), where x is a string of hexadecimal digits and spaces; 1335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * if there is only one string of hexadecimal digits, it is taken 1345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * for the 52 fraction bits of the resulting NaN; if there are two 1355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * or more strings of hex digits, the first is for the high 20 bits, 1365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * the second and subsequent for the low 32 bits, with intervening 1375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * white space ignored; but if this results in none of the 52 1385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * fraction bits being on (an IEEE Infinity symbol), then NAN_WORD0 1395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * and NAN_WORD1 are used instead. 1405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define MULTIPLE_THREADS if the system offers preemptively scheduled 1415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * multiple threads. In this case, you must provide (or suitably 1425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define) two locks, acquired by ACQUIRE_DTOA_LOCK(n) and freed 1435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * by FREE_DTOA_LOCK(n) for n = 0 or 1. (The second lock, accessed 1445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * in pow5mult, ensures lazy evaluation of only one copy of high 1455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * powers of 5; omitting this lock would introduce a small 1465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * probability of wasting memory, but would otherwise be harmless.) 1475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * You must also invoke freedtoa(s) to free the value s returned by 1485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * dtoa. You may do so whether or not MULTIPLE_THREADS is #defined. 1495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define NO_IEEE_Scale to disable new (Feb. 1997) logic in strtod that 1505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * avoids underflows on inputs whose result does not underflow. 1515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * If you #define NO_IEEE_Scale on a machine that uses IEEE-format 1525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * floating-point numbers and flushes underflows to zero rather 1535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * than implementing gradual underflow, then you must also #define 1545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Sudden_Underflow. 1555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define USE_LOCALE to use the current locale's decimal_point value. 1565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define SET_INEXACT if IEEE arithmetic is being used and extra 1575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * computation should be done to set the inexact flag when the 1585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * result is inexact and avoid setting inexact when the result 1595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * is exact. In this case, dtoa.c must be compiled in 1605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * an environment, perhaps provided by #include "dtoa.c" in a 1615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * suitable wrapper, that defines two functions, 1625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * int get_inexact(void); 1635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * void clear_inexact(void); 1645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * such that get_inexact() returns a nonzero value if the 1655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * inexact bit is already set, and clear_inexact() sets the 1665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * inexact bit to 0. When SET_INEXACT is #defined, strtod 1675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * also does extra computations to set the underflow and overflow 1685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * flags when appropriate (i.e., when the result is tiny and 1695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * inexact or when it is a numeric value rounded to +-infinity). 1705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define NO_ERRNO if strtod should not assign errno = ERANGE when 1715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * the result overflows to +-Infinity or underflows to 0. 1725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define NO_HEX_FP to omit recognition of hexadecimal floating-point 1735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * values by strtod. 1745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define NO_STRTOD_BIGCOMP (on IEEE-arithmetic systems only for now) 1755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * to disable logic for "fast" testing of very long input strings 1765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * to strtod. This testing proceeds by initially truncating the 1775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * input string, then if necessary comparing the whole string with 1785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * a decimal expansion to decide close cases. This logic is only 1795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * used for input more than STRTOD_DIGLIM digits long (default 40). 1805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 1815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1824e180b6a0b4720a9b8e9e959a882386f690f08ffTorne (Richard Coles)#if defined _MSC_VER && _MSC_VER == 1800 1834e180b6a0b4720a9b8e9e959a882386f690f08ffTorne (Richard Coles)// TODO(scottmg): VS2013 RC ICEs on a bunch of functions in this file. 1844e180b6a0b4720a9b8e9e959a882386f690f08ffTorne (Richard Coles)// This should be removed after RTM. See http://crbug.com/288948. 1854e180b6a0b4720a9b8e9e959a882386f690f08ffTorne (Richard Coles)#pragma optimize("", off) 1864e180b6a0b4720a9b8e9e959a882386f690f08ffTorne (Richard Coles)#endif 1874e180b6a0b4720a9b8e9e959a882386f690f08ffTorne (Richard Coles) 1885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define IEEE_8087 1895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define NO_HEX_FP 1905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Long 1925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#if __LP64__ 1935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Long int 1945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 1955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Long long 1965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 1975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 1985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef ULong 1995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)typedef unsigned Long ULong; 2005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef DEBUG 2035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#include "stdio.h" 2045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bug(x) {fprintf(stderr, "%s\n", x); exit(1);} 2055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#include "stdlib.h" 2085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#include "string.h" 2095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef USE_LOCALE 2115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#include "locale.h" 2125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 2155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Trust_FLT_ROUNDS 2165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#include <fenv.h> 2175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef MALLOC 2215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 2225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)extern char *MALLOC(); 2235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 2245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)extern void *MALLOC(size_t); 2255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 2275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define MALLOC malloc 2285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Omit_Private_Memory 2315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef PRIVATE_MEM 2325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define PRIVATE_MEM 2304 2335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define PRIVATE_mem ((unsigned)((PRIVATE_MEM+sizeof(double)-1)/sizeof(double))) 2355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)static double private_mem[PRIVATE_mem], *pmem_next = private_mem; 2365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef IEEE_Arith 2395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Avoid_Underflow 2405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_MC68k 2415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define IEEE_Arith 2425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_8087 2445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define IEEE_Arith 2455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 2485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_INFNAN_CHECK 2495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef INFNAN_CHECK 2505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define INFNAN_CHECK 2515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 2535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef INFNAN_CHECK 2545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define NO_STRTOD_BIGCOMP 2555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#include "errno.h" 2585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Bad_float_h 2605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 2625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_DIG 15 2635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_MAX_10_EXP 308 2645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_MAX_EXP 1024 2655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define FLT_RADIX 2 2665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*IEEE_Arith*/ 2675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 2695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_DIG 16 2705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_MAX_10_EXP 75 2715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_MAX_EXP 63 2725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define FLT_RADIX 16 2735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_MAX 7.2370055773322621e+75 2745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef VAX 2775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_DIG 16 2785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_MAX_10_EXP 38 2795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_MAX_EXP 127 2805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define FLT_RADIX 2 2815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define DBL_MAX 1.7014118346046923e+38 2825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef LONG_MAX 2855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define LONG_MAX 2147483647 2865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /* ifndef Bad_float_h */ 2895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#include "float.h" 2905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* Bad_float_h */ 2915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef __MATH_H__ 2935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#include "math.h" 2945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 2955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)namespace dmg_fp { 2975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef CONST 2995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 3005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define CONST /* blank */ 3015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 3025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define CONST const 3035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#if defined(IEEE_8087) + defined(IEEE_MC68k) + defined(VAX) + defined(IBM) != 1 3075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)Exactly one of IEEE_8087, IEEE_MC68k, VAX, or IBM should be defined. 3085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)typedef union { double d; ULong L[2]; } U; 3115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_8087 3135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define word0(x) (x)->L[1] 3145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define word1(x) (x)->L[0] 3155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 3165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define word0(x) (x)->L[0] 3175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define word1(x) (x)->L[1] 3185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define dval(x) (x)->d 3205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef STRTOD_DIGLIM 3225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define STRTOD_DIGLIM 40 3235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef DIGLIM_DEBUG 3265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)extern int strtod_diglim; 3275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 3285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define strtod_diglim STRTOD_DIGLIM 3295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* The following definition of Storeinc is appropriate for MIPS processors. 3325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * An alternative that might be better on some machines is 3335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff) 3345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 3355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#if defined(IEEE_8087) + defined(VAX) 3365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Storeinc(a,b,c) (((unsigned short *)a)[1] = (unsigned short)b, \ 3375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)((unsigned short *)a)[0] = (unsigned short)c, a++) 3385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 3395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Storeinc(a,b,c) (((unsigned short *)a)[0] = (unsigned short)b, \ 3405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)((unsigned short *)a)[1] = (unsigned short)c, a++) 3415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* #define P DBL_MANT_DIG */ 3445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* Ten_pmax = floor(P*log(2)/log(5)) */ 3455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */ 3465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */ 3475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */ 3485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 3505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_shift 20 3515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_shift1 20 3525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_msk1 0x100000 3535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_msk11 0x100000 3545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_mask 0x7ff00000 3555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define P 53 3565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Nbits 53 3575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bias 1023 3585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Emax 1023 3595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Emin (-1022) 3605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_1 0x3ff00000 3615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_11 0x3ff00000 3625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Ebits 11 3635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Frac_mask 0xfffff 3645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Frac_mask1 0xfffff 3655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Ten_pmax 22 3665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bletch 0x10 3675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bndry_mask 0xfffff 3685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bndry_mask1 0xfffff 3695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define LSB 1 3705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Sign_bit 0x80000000 3715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Log2P 1 3725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Tiny0 0 3735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Tiny1 1 3745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Quick_max 14 3755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Int_max 14 3765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_IEEE_Scale 3775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Avoid_Underflow 3785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Flush_Denorm /* debugging option */ 3795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Sudden_Underflow 3805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Flt_Rounds 3845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef FLT_ROUNDS 3855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Flt_Rounds FLT_ROUNDS 3865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 3875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Flt_Rounds 1 3885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Flt_Rounds*/ 3905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 3925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Check_FLT_ROUNDS 3935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Check_FLT_ROUNDS 3945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 3955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Rounding Flt_Rounds 3965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 3975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /* ifndef IEEE_Arith */ 3995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Check_FLT_ROUNDS 4005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Honor_FLT_ROUNDS 4015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef SET_INEXACT 4025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Sudden_Underflow 4035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Sudden_Underflow 4045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 4055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Flt_Rounds 4065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Flt_Rounds 0 4075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_shift 24 4085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_shift1 24 4095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_msk1 0x1000000 4105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_msk11 0x1000000 4115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_mask 0x7f000000 4125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define P 14 4135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Nbits 56 4145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bias 65 4155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Emax 248 4165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Emin (-260) 4175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_1 0x41000000 4185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_11 0x41000000 4195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Ebits 8 /* exponent has 7 bits, but 8 is the right value in b2d */ 4205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Frac_mask 0xffffff 4215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Frac_mask1 0xffffff 4225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bletch 4 4235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Ten_pmax 22 4245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bndry_mask 0xefffff 4255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bndry_mask1 0xffffff 4265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define LSB 1 4275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Sign_bit 0x80000000 4285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Log2P 4 4295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Tiny0 0x100000 4305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Tiny1 0 4315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Quick_max 14 4325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Int_max 15 4335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /* VAX */ 4345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Flt_Rounds 4355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Flt_Rounds 1 4365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_shift 23 4375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_shift1 7 4385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_msk1 0x80 4395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_msk11 0x800000 4405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_mask 0x7f80 4415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define P 56 4425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Nbits 56 4435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bias 129 4445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Emax 126 4455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Emin (-129) 4465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_1 0x40800000 4475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Exp_11 0x4080 4485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Ebits 8 4495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Frac_mask 0x7fffff 4505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Frac_mask1 0xffff007f 4515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Ten_pmax 24 4525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bletch 2 4535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bndry_mask 0xffff007f 4545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bndry_mask1 0xffff007f 4555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define LSB 0x10000 4565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Sign_bit 0x8000 4575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Log2P 1 4585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Tiny0 0x80 4595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Tiny1 0 4605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Quick_max 15 4615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Int_max 15 4625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* IBM, VAX */ 4635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* IEEE_Arith */ 4645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 4655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef IEEE_Arith 4665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define ROUND_BIASED 4675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 4685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 4695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef RND_PRODQUOT 4705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define rounded_product(a,b) a = rnd_prod(a, b) 4715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define rounded_quotient(a,b) a = rnd_quot(a, b) 4725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 4735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)extern double rnd_prod(), rnd_quot(); 4745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 4755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)extern double rnd_prod(double, double), rnd_quot(double, double); 4765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 4775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 4785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define rounded_product(a,b) a *= b 4795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define rounded_quotient(a,b) a /= b 4805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 4815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 4825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1)) 4835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Big1 0xffffffff 4845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 4855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Pack_32 4865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Pack_32 4875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 4885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 4895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)typedef struct BCinfo BCinfo; 4905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) struct 4915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)BCinfo { int dp0, dp1, dplen, dsign, e0, inexact, nd, nd0, rounding, scale, uflchk; }; 4925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 4935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 4945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define FFFFFFFF ((((unsigned long)0xffff)<<16)|(unsigned long)0xffff) 4955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 4965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define FFFFFFFF 0xffffffffUL 4975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 4985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 4995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef NO_LONG_LONG 5005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef ULLong 5015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Just_16 5025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Pack_32 5035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* When Pack_32 is not defined, we store 16 bits per 32-bit Long. 5045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * This makes some inner loops simpler and sometimes saves work 5055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * during multiplications, but it often seems to make things slightly 5065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * slower. Hence the default is now to store 32 bits per Long. 5075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 5085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 5095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /* long long available */ 5105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Llong 5115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Llong long long 5125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 5135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef ULLong 5145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define ULLong unsigned Llong 5155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 5165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* NO_LONG_LONG */ 5175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 5185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef MULTIPLE_THREADS 5195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define ACQUIRE_DTOA_LOCK(n) /*nothing*/ 5205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define FREE_DTOA_LOCK(n) /*nothing*/ 5215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 5225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 5235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Kmax 7 5245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 5255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)double strtod(const char *s00, char **se); 5265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)char *dtoa(double d, int mode, int ndigits, 5275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int *decpt, int *sign, char **rve); 5285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 5295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) struct 5305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)Bigint { 5315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) struct Bigint *next; 5325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int k, maxwds, sign, wds; 5335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong x[1]; 5345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) }; 5355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 5365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) typedef struct Bigint Bigint; 5375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 5385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint *freelist[Kmax+1]; 5395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 5405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 5415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)Balloc 5425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 5435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (k) int k; 5445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 5455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (int k) 5465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 5475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 5485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int x; 5495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *rv; 5505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Omit_Private_Memory 5515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) unsigned int len; 5525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 5535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 5545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ACQUIRE_DTOA_LOCK(0); 5555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* The k > Kmax case does not need ACQUIRE_DTOA_LOCK(0), */ 5565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* but this case seems very unlikely. */ 5575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k <= Kmax && (rv = freelist[k])) 5585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) freelist[k] = rv->next; 5595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 5605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = 1 << k; 5615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Omit_Private_Memory 5625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv = (Bigint *)MALLOC(sizeof(Bigint) + (x-1)*sizeof(ULong)); 5635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 5645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) len = (sizeof(Bigint) + (x-1)*sizeof(ULong) + sizeof(double) - 1) 5655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /sizeof(double); 5665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k <= Kmax && pmem_next - private_mem + len <= PRIVATE_mem) { 5675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv = (Bigint*)pmem_next; 5685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) pmem_next += len; 5695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 5705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 5715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv = (Bigint*)MALLOC(len*sizeof(double)); 5725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 5735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv->k = k; 5745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv->maxwds = x; 5755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 5765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) FREE_DTOA_LOCK(0); 5775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv->sign = rv->wds = 0; 5785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return rv; 5795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 5805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 5815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static void 5825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)Bfree 5835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 5845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (v) Bigint *v; 5855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 5865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *v) 5875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 5885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 5895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (v) { 5905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (v->k > Kmax) 5915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef FREE 5925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) FREE((void*)v); 5935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 5945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) free((void*)v); 5955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 5965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 5975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ACQUIRE_DTOA_LOCK(0); 5985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) v->next = freelist[v->k]; 5995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) freelist[v->k] = v; 6005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) FREE_DTOA_LOCK(0); 6015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 6025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 6035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 6045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 6055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Bcopy(x,y) memcpy((char *)&x->sign, (char *)&y->sign, \ 6065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)y->wds*sizeof(Long) + 2*sizeof(int)) 6075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 6085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 6095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)multadd 6105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 6115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (b, m, a) Bigint *b; int m, a; 6125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 6135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *b, int m, int a) /* multiply by m and add a */ 6145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 6155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 6165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int i, wds; 6175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef ULLong 6185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *x; 6195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULLong carry, y; 6205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 6215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong carry, *x, y; 6225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 6235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong xi, z; 6245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 6255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 6265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b1; 6275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 6285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) wds = b->wds; 6295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = b->x; 6305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 0; 6315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = a; 6325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 6335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef ULLong 6345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *x * (ULLong)m + carry; 6355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = y >> 32; 6365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x++ = y & FFFFFFFF; 6375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 6385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 6395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xi = *x; 6405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = (xi & 0xffff) * m + carry; 6415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = (xi >> 16) * m + (y >> 16); 6425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = z >> 16; 6435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x++ = (z << 16) + (y & 0xffff); 6445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 6455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *x * m + carry; 6465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = y >> 16; 6475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x++ = y & 0xffff; 6485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 6495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 6505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 6515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(++i < wds); 6525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (carry) { 6535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (wds >= b->maxwds) { 6545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b1 = Balloc(b->k+1); 6555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bcopy(b1, b); 6565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 6575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = b1; 6585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 6595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->x[wds++] = carry; 6605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = wds; 6615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 6625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return b; 6635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 6645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 6655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 6665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)s2b 6675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 6685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (s, nd0, nd, y9, dplen) CONST char *s; int nd0, nd, dplen; ULong y9; 6695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 6705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (CONST char *s, int nd0, int nd, ULong y9, int dplen) 6715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 6725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 6735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b; 6745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int i, k; 6755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Long x, y; 6765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 6775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = (nd + 8) / 9; 6785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(k = 0, y = 1; x > y; y <<= 1, k++) ; 6795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 6805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = Balloc(k); 6815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->x[0] = y9; 6825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = 1; 6835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 6845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = Balloc(k+1); 6855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->x[0] = y9 & 0xffff; 6865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = (b->x[1] = y9 >> 16) ? 2 : 1; 6875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 6885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 6895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 9; 6905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (9 < nd0) { 6915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s += 9; 6925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do b = multadd(b, 10, *s++ - '0'); 6935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(++i < nd0); 6945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s += dplen; 6955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 6965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 6975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s += dplen + 9; 6985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(; i < nd; i++) 6995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = multadd(b, 10, *s++ - '0'); 7005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return b; 7015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 7035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static int 7045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)hi0bits 7055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 7065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (x) ULong x; 7075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 7085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (ULong x) 7095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 7105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 7115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int k = 0; 7125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 7135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0xffff0000)) { 7145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = 16; 7155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x <<= 16; 7165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0xff000000)) { 7185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k += 8; 7195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x <<= 8; 7205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0xf0000000)) { 7225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k += 4; 7235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x <<= 4; 7245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0xc0000000)) { 7265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k += 2; 7275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x <<= 2; 7285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0x80000000)) { 7305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k++; 7315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0x40000000)) 7325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 32; 7335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return k; 7355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 7375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static int 7385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)lo0bits 7395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 7405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (y) ULong *y; 7415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 7425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (ULong *y) 7435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 7445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 7455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int k; 7465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong x = *y; 7475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 7485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (x & 7) { 7495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (x & 1) 7505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 0; 7515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (x & 2) { 7525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *y = x >> 1; 7535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 1; 7545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *y = x >> 2; 7565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 2; 7575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = 0; 7595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0xffff)) { 7605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = 16; 7615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x >>= 16; 7625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0xff)) { 7645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k += 8; 7655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x >>= 8; 7665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0xf)) { 7685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k += 4; 7695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x >>= 4; 7705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 0x3)) { 7725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k += 2; 7735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x >>= 2; 7745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(x & 1)) { 7765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k++; 7775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x >>= 1; 7785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!x) 7795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 32; 7805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *y = x; 7825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return k; 7835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 7845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 7855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 7865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)i2b 7875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 7885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (i) int i; 7895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 7905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (int i) 7915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 7925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 7935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b; 7945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 7955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = Balloc(1); 7965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->x[0] = i; 7975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = 1; 7985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return b; 7995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 8015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 8025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)mult 8035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 8045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (a, b) Bigint *a, *b; 8055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 8065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *a, Bigint *b) 8075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 8085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 8095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *c; 8105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int k, wa, wb, wc; 8115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *x, *xa, *xae, *xb, *xbe, *xc, *xc0; 8125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong y; 8135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef ULLong 8145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULLong carry, z; 8155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 8165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong carry, z; 8175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 8185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong z2; 8195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 8205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 8215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 8225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (a->wds < b->wds) { 8235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = a; 8245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) a = b; 8255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = c; 8265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = a->k; 8285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) wa = a->wds; 8295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) wb = b->wds; 8305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) wc = wa + wb; 8315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (wc > a->maxwds) 8325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k++; 8335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = Balloc(k); 8345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(x = c->x, xa = x + wc; x < xa; x++) 8355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x = 0; 8365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xa = a->x; 8375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xae = xa + wa; 8385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xb = b->x; 8395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xbe = xb + wb; 8405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xc0 = c->x; 8415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef ULLong 8425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(; xb < xbe; xc0++) { 8435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((y = *xb++)) { 8445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = xa; 8455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xc = xc0; 8465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = 0; 8475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 8485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = *x++ * (ULLong)y + *xc + carry; 8495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = z >> 32; 8505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc++ = z & FFFFFFFF; 8515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x < xae); 8535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc = carry; 8545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 8575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 8585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(; xb < xbe; xb++, xc0++) { 8595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (y = *xb & 0xffff) { 8605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = xa; 8615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xc = xc0; 8625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = 0; 8635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 8645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = (*x & 0xffff) * y + (*xc & 0xffff) + carry; 8655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = z >> 16; 8665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z2 = (*x++ >> 16) * y + (*xc >> 16) + carry; 8675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = z2 >> 16; 8685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Storeinc(xc, z2, z); 8695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x < xae); 8715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc = carry; 8725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (y = *xb >> 16) { 8745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = xa; 8755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xc = xc0; 8765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = 0; 8775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z2 = *xc; 8785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 8795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = (*x & 0xffff) * y + (*xc >> 16) + carry; 8805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = z >> 16; 8815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Storeinc(xc, z, z2); 8825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry; 8835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = z2 >> 16; 8845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x < xae); 8865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc = z2; 8875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 8895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 8905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(; xb < xbe; xc0++) { 8915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (y = *xb++) { 8925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = xa; 8935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xc = xc0; 8945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = 0; 8955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 8965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = *x++ * y + *xc + carry; 8975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = z >> 16; 8985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc++ = z & 0xffff; 8995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x < xae); 9015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc = carry; 9025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 9055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 9065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc) ; 9075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c->wds = wc; 9085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return c; 9095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 9115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint *p5s; 9125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 9135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 9145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)pow5mult 9155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 9165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (b, k) Bigint *b; int k; 9175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 9185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *b, int k) 9195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 9205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 9215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b1, *p5, *p51; 9225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int i; 9235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static int p05[3] = { 5, 25, 125 }; 9245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 9255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((i = k & 3)) 9265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = multadd(b, p05[i-1], 0); 9275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 9285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(k >>= 2)) 9295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return b; 9305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(p5 = p5s)) { 9315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* first time */ 9325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef MULTIPLE_THREADS 9335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ACQUIRE_DTOA_LOCK(1); 9345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(p5 = p5s)) { 9355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p5 = p5s = i2b(625); 9365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p5->next = 0; 9375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) FREE_DTOA_LOCK(1); 9395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 9405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p5 = p5s = i2b(625); 9415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p5->next = 0; 9425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 9435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(;;) { 9455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k & 1) { 9465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b1 = mult(b, p5); 9475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 9485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = b1; 9495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(k >>= 1)) 9515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 9525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(p51 = p5->next)) { 9535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef MULTIPLE_THREADS 9545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ACQUIRE_DTOA_LOCK(1); 9555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(p51 = p5->next)) { 9565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p51 = p5->next = mult(p5,p5); 9575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p51->next = 0; 9585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) FREE_DTOA_LOCK(1); 9605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 9615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p51 = p5->next = mult(p5,p5); 9625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p51->next = 0; 9635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 9645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p5 = p51; 9665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return b; 9685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 9695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 9705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 9715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)lshift 9725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 9735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (b, k) Bigint *b; int k; 9745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 9755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *b, int k) 9765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 9775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 9785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int i, k1, n, n1; 9795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b1; 9805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *x, *x1, *xe, z; 9815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 9825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 9835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = k >> 5; 9845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 9855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = k >> 4; 9865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 9875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k1 = b->k; 9885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n1 = n + b->wds + 1; 9895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = b->maxwds; n1 > i; i <<= 1) 9905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k1++; 9915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b1 = Balloc(k1); 9925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x1 = b1->x; 9935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 0; i < n; i++) 9945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x1++ = 0; 9955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = b->x; 9965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xe = x + b->wds; 9975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 9985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k &= 0x1f) { 9995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k1 = 32 - k; 10005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = 0; 10015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 10025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x1++ = *x << k | z; 10035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = *x++ >> k1; 10045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 10055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x < xe); 10065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((*x1 = z)) 10075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ++n1; 10085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 10095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 10105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k &= 0xf) { 10115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k1 = 16 - k; 10125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = 0; 10135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 10145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x1++ = *x << k & 0xffff | z; 10155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = *x++ >> k1; 10165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 10175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x < xe); 10185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*x1 = z) 10195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ++n1; 10205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 10215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 10225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else do 10235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x1++ = *x++; 10245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x < xe); 10255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b1->wds = n1 - 1; 10265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 10275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return b1; 10285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 10295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 10305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static int 10315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)cmp 10325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 10335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (a, b) Bigint *a, *b; 10345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 10355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *a, Bigint *b) 10365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 10375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 10385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *xa, *xa0, *xb, *xb0; 10395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int i, j; 10405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 10415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = a->wds; 10425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = b->wds; 10435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef DEBUG 10445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i > 1 && !a->x[i-1]) 10455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bug("cmp called with a->x[a->wds-1] == 0"); 10465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j > 1 && !b->x[j-1]) 10475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bug("cmp called with b->x[b->wds-1] == 0"); 10485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 10495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i -= j) 10505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return i; 10515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xa0 = a->x; 10525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xa = xa0 + j; 10535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xb0 = b->x; 10545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xb = xb0 + j; 10555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(;;) { 10565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*--xa != *--xb) 10575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return *xa < *xb ? -1 : 1; 10585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (xa <= xa0) 10595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 10605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 10615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 0; 10625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 10635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 10645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 10655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)diff 10665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 10675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (a, b) Bigint *a, *b; 10685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 10695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *a, Bigint *b) 10705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 10715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 10725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *c; 10735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int i, wa, wb; 10745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *xa, *xae, *xb, *xbe, *xc; 10755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef ULLong 10765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULLong borrow, y; 10775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 10785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong borrow, y; 10795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 10805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong z; 10815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 10825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 10835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 10845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = cmp(a,b); 10855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!i) { 10865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = Balloc(0); 10875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c->wds = 1; 10885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c->x[0] = 0; 10895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return c; 10905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 10915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i < 0) { 10925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = a; 10935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) a = b; 10945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = c; 10955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 1; 10965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 10975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 10985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 0; 10995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = Balloc(a->k); 11005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c->sign = i; 11015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) wa = a->wds; 11025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xa = a->x; 11035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xae = xa + wa; 11045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) wb = b->wds; 11055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xb = b->x; 11065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xbe = xb + wb; 11075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xc = c->x; 11085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = 0; 11095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef ULLong 11105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 11115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = (ULLong)*xa++ - *xb++ - borrow; 11125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = y >> 32 & (ULong)1; 11135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc++ = y & FFFFFFFF; 11145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(xb < xbe); 11165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(xa < xae) { 11175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *xa++ - borrow; 11185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = y >> 32 & (ULong)1; 11195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc++ = y & FFFFFFFF; 11205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 11225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 11235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 11245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = (*xa & 0xffff) - (*xb & 0xffff) - borrow; 11255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (y & 0x10000) >> 16; 11265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = (*xa++ >> 16) - (*xb++ >> 16) - borrow; 11275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (z & 0x10000) >> 16; 11285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Storeinc(xc, z, y); 11295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(xb < xbe); 11315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(xa < xae) { 11325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = (*xa & 0xffff) - borrow; 11335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (y & 0x10000) >> 16; 11345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = (*xa++ >> 16) - borrow; 11355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (z & 0x10000) >> 16; 11365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Storeinc(xc, z, y); 11375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 11395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 11405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *xa++ - *xb++ - borrow; 11415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (y & 0x10000) >> 16; 11425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc++ = y & 0xffff; 11435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(xb < xbe); 11455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(xa < xae) { 11465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *xa++ - borrow; 11475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (y & 0x10000) >> 16; 11485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *xc++ = y & 0xffff; 11495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 11515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 11525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(!*--xc) 11535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) wa--; 11545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c->wds = wa; 11555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return c; 11565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 11585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static double 11595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)ulp 11605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 11615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (x) U *x; 11625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 11635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (U *x) 11645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 11655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 11665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Long L; 11675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) U u; 11685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 11695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = (word0(x) & Exp_mask) - (P-1)*Exp_msk1; 11705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Avoid_Underflow 11715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 11725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (L > 0) { 11735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 11745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 11755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 11765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L |= Exp_msk1 >> 4; 11775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 11785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&u) = L; 11795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&u) = 0; 11805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Avoid_Underflow 11815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 11825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 11845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = -L >> Exp_shift; 11855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (L < Exp_shift) { 11865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&u) = 0x80000 >> L; 11875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&u) = 0; 11885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 11905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&u) = 0; 11915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L -= Exp_shift; 11925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&u) = L >= 31 ? 1 : 1 << 31 - L; 11935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 11965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 11975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return dval(&u); 11985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 11995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 12005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static double 12015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)b2d 12025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 12035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (a, e) Bigint *a; int *e; 12045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 12055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *a, int *e) 12065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 12075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 12085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *xa, *xa0, w, y, z; 12095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int k; 12105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) U d; 12115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef VAX 12125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong d0, d1; 12135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 12145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define d0 word0(&d) 12155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define d1 word1(&d) 12165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 12175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 12185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xa0 = a->x; 12195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xa = xa0 + a->wds; 12205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *--xa; 12215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef DEBUG 12225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!y) Bug("zero y in b2d"); 12235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 12245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = hi0bits(y); 12255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *e = 32 - k; 12265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 12275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k < Ebits) { 12285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d0 = Exp_1 | y >> (Ebits - k); 12295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) w = xa > xa0 ? *--xa : 0; 12305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d1 = y << ((32-Ebits) + k) | w >> (Ebits - k); 12315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret_d; 12325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 12335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = xa > xa0 ? *--xa : 0; 12345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k -= Ebits) { 12355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d0 = Exp_1 | y << k | z >> (32 - k); 12365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = xa > xa0 ? *--xa : 0; 12375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d1 = z << k | y >> (32 - k); 12385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 12395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 12405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d0 = Exp_1 | y; 12415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d1 = z; 12425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 12435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 12445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k < Ebits + 16) { 12455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = xa > xa0 ? *--xa : 0; 12465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d0 = Exp_1 | y << k - Ebits | z >> Ebits + 16 - k; 12475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) w = xa > xa0 ? *--xa : 0; 12485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = xa > xa0 ? *--xa : 0; 12495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d1 = z << k + 16 - Ebits | w << k - Ebits | y >> 16 + Ebits - k; 12505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret_d; 12515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 12525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = xa > xa0 ? *--xa : 0; 12535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) w = xa > xa0 ? *--xa : 0; 12545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k -= Ebits + 16; 12555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d0 = Exp_1 | y << k + 16 | z << k | w >> 16 - k; 12565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = xa > xa0 ? *--xa : 0; 12575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d1 = w << k + 16 | y << k; 12585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 12595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ret_d: 12605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef VAX 12615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&d) = d0 >> 16 | d0 << 16; 12625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&d) = d1 >> 16 | d1 << 16; 12635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 12645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef d0 12655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef d1 12665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 12675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return dval(&d); 12685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 12695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 12705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 12715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)d2b 12725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 12735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (d, e, bits) U *d; int *e, *bits; 12745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 12755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (U *d, int *e, int *bits) 12765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 12775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 12785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b; 12795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int de, k; 12805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *x, y, z; 12815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 12825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int i; 12835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 12845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef VAX 12855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong d0, d1; 12865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d0 = word0(d) >> 16 | word0(d) << 16; 12875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d1 = word1(d) >> 16 | word1(d) << 16; 12885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 12895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define d0 word0(d) 12905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define d1 word1(d) 12915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 12925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 12935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 12945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = Balloc(1); 12955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 12965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = Balloc(2); 12975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 12985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = b->x; 12995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 13005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = d0 & Frac_mask; 13015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d0 &= 0x7fffffff; /* clear sign bit, which we ignore */ 13025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Sudden_Underflow 13035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) de = (int)(d0 >> Exp_shift); 13045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef IBM 13055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z |= Exp_msk11; 13065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 13085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((de = (int)(d0 >> Exp_shift))) 13095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z |= Exp_msk1; 13105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 13125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((y = d1)) { 13135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((k = lo0bits(&y))) { 13145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = y | z << (32 - k); 13155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z >>= k; 13165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 13185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = y; 13195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 13205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 13215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = (x[1] = z) ? 2 : 1; 13235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 13255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = lo0bits(&z); 13265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = z; 13275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 13285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 13295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = 1; 13315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k += 32; 13325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 13345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (y = d1) { 13355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k = lo0bits(&y)) 13365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k >= 16) { 13375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = y | z << 32 - k & 0xffff; 13385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[1] = z >> k - 16 & 0xffff; 13395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[2] = z >> k; 13405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 2; 13415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 13435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = y & 0xffff; 13445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[1] = y >> 16 | z << 16 - k & 0xffff; 13455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[2] = z >> k & 0xffff; 13465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[3] = z >> k+16; 13475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 3; 13485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 13505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = y & 0xffff; 13515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[1] = y >> 16; 13525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[2] = z & 0xffff; 13535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[3] = z >> 16; 13545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 3; 13555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 13585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef DEBUG 13595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!z) 13605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bug("Zero passed to d2b"); 13615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = lo0bits(&z); 13635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k >= 16) { 13645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = z; 13655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 0; 13665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 13685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = z & 0xffff; 13695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[1] = z >> 16; 13705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 1; 13715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k += 32; 13735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(!x[i]) 13755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) --i; 13765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = i + 1; 13775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 13795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (de) { 13805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 13825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *e = (de - Bias - (P-1) << 2) + k; 13835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *bits = 4*P + 8 - k - hi0bits(word0(d) & Frac_mask); 13845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 13855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *e = de - Bias - (P-1) + k; 13865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *bits = P - k; 13875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 13895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 13915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *e = de - Bias - (P-1) + 1 + k; 13925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 13935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *bits = 32*i - hi0bits(x[i-1]); 13945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 13955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *bits = (i+2)*16 - hi0bits(x[i]); 13965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 13985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 13995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return b; 14005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 14015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef d0 14025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef d1 14035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 14045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static double 14055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)ratio 14065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 14075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (a, b) Bigint *a, *b; 14085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 14095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *a, Bigint *b) 14105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 14125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) U da, db; 14135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int k, ka, kb; 14145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 14155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&da) = b2d(a, &ka); 14165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&db) = b2d(b, &kb); 14175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 14185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = ka - kb + 32*(a->wds - b->wds); 14195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 14205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = ka - kb + 16*(a->wds - b->wds); 14215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 14235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k > 0) { 14245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&da) += (k >> 2)*Exp_msk1; 14255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k &= 3) 14265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&da) *= 1 << k; 14275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 14285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 14295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = -k; 14305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&db) += (k >> 2)*Exp_msk1; 14315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k &= 3) 14325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&db) *= 1 << k; 14335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 14345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 14355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k > 0) 14365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&da) += k*Exp_msk1; 14375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 14385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = -k; 14395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&db) += k*Exp_msk1; 14405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 14415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return dval(&da) / dval(&db); 14435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 14445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 14455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static CONST double 14465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)tens[] = { 14475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9, 14485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 14495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1e20, 1e21, 1e22 14505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef VAX 14515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) , 1e23, 1e24 14525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) }; 14545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 14555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static CONST double 14565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 14575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 }; 14585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128, 14595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 14605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 9007199254740992.*9007199254740992.e-256 14615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* = 2^106 * 1e-256 */ 14625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 14635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1e-256 14645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) }; 14665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */ 14675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* flag unnecessarily. It leads to a song and dance at the end of strtod. */ 14685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Scale_Bit 0x10 14695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define n_bigtens 5 14705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 14715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 14725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)bigtens[] = { 1e16, 1e32, 1e64 }; 14735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64 }; 14745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define n_bigtens 3 14755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 14765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)bigtens[] = { 1e16, 1e32 }; 14775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)static CONST double tinytens[] = { 1e-16, 1e-32 }; 14785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define n_bigtens 2 14795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 14825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#undef Need_Hexdig 14835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef INFNAN_CHECK 14845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef No_Hex_NaN 14855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Need_Hexdig 14865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 14895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Need_Hexdig 14905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_HEX_FP 14915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define Need_Hexdig 14925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 14945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 14955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Need_Hexdig /*{*/ 14965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)static unsigned char hexdig[256]; 14975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 14985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static void 14995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 15005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)htinit(h, s, inc) unsigned char *h; unsigned char *s; int inc; 15015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 15025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)htinit(unsigned char *h, unsigned char *s, int inc) 15035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 15045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 15055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int i, j; 15065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 0; (j = s[i]) !=0; i++) 15075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) h[j] = i + inc; 15085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 15095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 15105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static void 15115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 15125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)hexdig_init() 15135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 15145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)hexdig_init(void) 15155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 15165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 15175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define USC (unsigned char *) 15185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) htinit(hexdig, USC "0123456789", 0x10); 15195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) htinit(hexdig, USC "abcdef", 0x10 + 10); 15205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) htinit(hexdig, USC "ABCDEF", 0x10 + 10); 15215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 15225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* } Need_Hexdig */ 15235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 15245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef INFNAN_CHECK 15255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 15265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NAN_WORD0 15275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define NAN_WORD0 0x7ff80000 15285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 15295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 15305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NAN_WORD1 15315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define NAN_WORD1 0 15325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 15335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 15345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static int 15355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)match 15365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 15375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (sp, t) char **sp, *t; 15385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 15395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (CONST char **sp, CONST char *t) 15405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 15415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 15425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int c, d; 15435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) CONST char *s = *sp; 15445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 15455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while((d = *t++)) { 15465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((c = *++s) >= 'A' && c <= 'Z') 15475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c += 'a' - 'A'; 15485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (c != d) 15495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 0; 15505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 15515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *sp = s + 1; 15525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 1; 15535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 15545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 15555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef No_Hex_NaN 15565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static void 15575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)hexnan 15585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 15595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (rvp, sp) U *rvp; CONST char **sp; 15605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 15615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (U *rvp, CONST char **sp) 15625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 15635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 15645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong c, x[2]; 15655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) CONST char *s; 15665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int c1, havedig, udx0, xshift; 15675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 15685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!hexdig['0']) 15695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) hexdig_init(); 15705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = x[1] = 0; 15715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) havedig = xshift = 0; 15725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) udx0 = 1; 15735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s = *sp; 15745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* allow optional initial 0x or 0X */ 15755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while((c = *(CONST unsigned char*)(s+1)) && c <= ' ') 15765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ++s; 15775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s[1] == '0' && (s[2] == 'x' || s[2] == 'X')) 15785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s += 2; 15795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while((c = *(CONST unsigned char*)++s)) { 15805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((c1 = hexdig[c])) 15815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = c1 & 0xf; 15825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (c <= ' ') { 15835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (udx0 && havedig) { 15845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) udx0 = 0; 15855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xshift = 1; 15865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 15875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) continue; 15885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 15895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef GDTOA_NON_PEDANTIC_NANCHECK 15905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (/*(*/ c == ')' && havedig) { 15915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *sp = s + 1; 15925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 15935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 15945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 15955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return; /* invalid form: don't change *sp */ 15965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 15975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 15985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 15995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (/*(*/ c == ')') { 16005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *sp = s + 1; 16015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 16025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } while((c = *++s)); 16045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 16055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 16075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) havedig = 1; 16085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (xshift) { 16095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xshift = 0; 16105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = x[1]; 16115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[1] = 0; 16125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (udx0) 16145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[0] = (x[0] << 4) | (x[1] >> 28); 16155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x[1] = (x[1] << 4) | c; 16165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((x[0] &= 0xfffff) || x[1]) { 16185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rvp) = Exp_mask | x[0]; 16195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(rvp) = x[1]; 16205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*No_Hex_NaN*/ 16235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* INFNAN_CHECK */ 16245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 16255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 16265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define ULbits 32 16275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define kshift 5 16285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define kmask 31 16295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 16305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define ULbits 16 16315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define kshift 4 16325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define kmask 15 16335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 16345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_HEX_FP /*{*/ 16355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 16365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static void 16375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 16385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)rshift(b, k) Bigint *b; int k; 16395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 16405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)rshift(Bigint *b, int k) 16415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 16425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 16435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *x, *x1, *xe, y; 16445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int n; 16455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 16465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = x1 = b->x; 16475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = k >> kshift; 16485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (n < b->wds) { 16495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xe = x + b->wds; 16505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x += n; 16515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k &= kmask) { 16525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = 32 - k; 16535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *x++ >> k; 16545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x < xe) { 16555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x1++ = (y | (*x << n)) & 0xffffffff; 16565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *x++ >> k; 16575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((*x1 = y) !=0) 16595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x1++; 16605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 16625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x < xe) 16635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x1++ = *x++; 16645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((b->wds = x1 - b->x) == 0) 16665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->x[0] = 0; 16675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 16695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static ULong 16705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 16715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)any_on(b, k) Bigint *b; int k; 16725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 16735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)any_on(Bigint *b, int k) 16745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 16755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 16765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int n, nwds; 16775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *x, *x0, x1, x2; 16785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 16795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = b->x; 16805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nwds = b->wds; 16815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = k >> kshift; 16825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (n > nwds) 16835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = nwds; 16845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (n < nwds && (k &= kmask)) { 16855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x1 = x2 = x[n]; 16865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x1 >>= k; 16875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x1 <<= k; 16885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (x1 != x2) 16895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 1; 16905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x0 = x; 16925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x += n; 16935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(x > x0) 16945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*--x) 16955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 1; 16965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 0; 16975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 16985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 16995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)enum { /* rounding values: same as FLT_ROUNDS */ 17005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Round_zero = 0, 17015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Round_near = 1, 17025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Round_up = 2, 17035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Round_down = 3 17045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) }; 17055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 17065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static Bigint * 17075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 17085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)increment(b) Bigint *b; 17095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 17105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)increment(Bigint *b) 17115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 17125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 17135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *x, *xe; 17145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b1; 17155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 17165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = b->x; 17175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) xe = x + b->wds; 17185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 17195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*x < (ULong)0xffffffffL) { 17205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ++*x; 17215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return b; 17225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 17235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x++ = 0; 17245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } while(x < xe); 17255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) { 17265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (b->wds >= b->maxwds) { 17275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b1 = Balloc(b->k+1); 17285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bcopy(b1,b); 17295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 17305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = b1; 17315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 17325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->x[b->wds++] = 1; 17335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 17345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return b; 17355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 17365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 17375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) void 17385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 17395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)gethex(sp, rvp, rounding, sign) 17405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) CONST char **sp; U *rvp; int rounding, sign; 17415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 17425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)gethex( CONST char **sp, U *rvp, int rounding, int sign) 17435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 17445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 17455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b; 17465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) CONST unsigned char *decpt, *s0, *s, *s1; 17475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Long e, e1; 17485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong L, lostbits, *x; 17495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int big, denorm, esign, havedig, k, n, nbits, up, zret; 17505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 17515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int j; 17525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 17535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) enum { 17545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith /*{{*/ 17555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) emax = 0x7fe - Bias - P + 1, 17565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) emin = Emin - P + 1 17575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /*}{*/ 17585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) emin = Emin - P, 17595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef VAX 17605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) emax = 0x7ff - Bias - P + 1 17615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 17625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 17635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) emax = 0x7f - Bias - P 17645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 17655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*}}*/ 17665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) }; 17675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef USE_LOCALE 17685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int i; 17695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef NO_LOCALE_CACHE 17705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) const unsigned char *decimalpoint = (unsigned char*) 17715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) localeconv()->decimal_point; 17725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 17735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) const unsigned char *decimalpoint; 17745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static unsigned char *decimalpoint_cache; 17755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(s0 = decimalpoint_cache)) { 17765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s0 = (unsigned char*)localeconv()->decimal_point; 17775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((decimalpoint_cache = (unsigned char*) 17785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) MALLOC(strlen((CONST char*)s0) + 1))) { 17795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) strcpy((char*)decimalpoint_cache, (CONST char*)s0); 17805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s0 = decimalpoint_cache; 17815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 17825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 17835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) decimalpoint = s0; 17845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 17855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 17865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 17875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!hexdig['0']) 17885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) hexdig_init(); 17895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) havedig = 0; 17905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s0 = *(CONST unsigned char **)sp + 2; 17915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(s0[havedig] == '0') 17925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) havedig++; 17935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s0 += havedig; 17945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s = s0; 17955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) decpt = 0; 17965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) zret = 0; 17975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e = 0; 17985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (hexdig[*s]) 17995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) havedig++; 18005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 18015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) zret = 1; 18025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef USE_LOCALE 18035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 0; decimalpoint[i]; ++i) { 18045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s[i] != decimalpoint[i]) 18055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto pcheck; 18065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 18075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) decpt = s += i; 18085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 18095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*s != '.') 18105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto pcheck; 18115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) decpt = ++s; 18125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 18135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!hexdig[*s]) 18145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto pcheck; 18155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(*s == '0') 18165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s++; 18175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (hexdig[*s]) 18185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) zret = 0; 18195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) havedig = 1; 18205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s0 = s; 18215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 18225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(hexdig[*s]) 18235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s++; 18245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef USE_LOCALE 18255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*s == *decimalpoint && !decpt) { 18265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 1; decimalpoint[i]; ++i) { 18275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s[i] != decimalpoint[i]) 18285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto pcheck; 18295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 18305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) decpt = s += i; 18315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 18325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*s == '.' && !decpt) { 18335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) decpt = ++s; 18345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 18355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(hexdig[*s]) 18365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s++; 18375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) }/*}*/ 18385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (decpt) 18395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e = -(((Long)(s-decpt)) << 2); 18405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) pcheck: 18415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s1 = s; 18425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) big = esign = 0; 18435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(*s) { 18445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 'p': 18455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 'P': 18465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(*++s) { 18475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '-': 18485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) esign = 1; 18495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* no break */ 18505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '+': 18515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s++; 18525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 18535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((n = hexdig[*s]) == 0 || n > 0x19) { 18545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s = s1; 18555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 18565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 18575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e1 = n - 0x10; 18585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while((n = hexdig[*++s]) !=0 && n <= 0x19) { 18595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 & 0xf8000000) 18605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) big = 1; 18615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e1 = 10*e1 + n - 0x10; 18625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 18635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (esign) 18645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e1 = -e1; 18655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e += e1; 18665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 18675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *sp = (char*)s; 18685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!havedig) 18695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *sp = (char*)s0 - 1; 18705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (zret) 18715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto retz1; 18725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (big) { 18735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (esign) { 18745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 18755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(rounding) { 18765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_up: 18775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (sign) 18785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 18795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret_tiny; 18805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_down: 18815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!sign) 18825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 18835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret_tiny; 18845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 18855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 18865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto retz; 18875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 18885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ret_tiny: 18895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_ERRNO 18905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) errno = ERANGE; 18915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 18925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rvp) = 0; 18935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(rvp) = 1; 18945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return; 18955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* IEEE_Arith */ 18965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 18975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(rounding) { 18985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_near: 18995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ovfl1; 19005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_up: 19015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!sign) 19025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ovfl1; 19035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret_big; 19045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_down: 19055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (sign) 19065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ovfl1; 19075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret_big; 19085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ret_big: 19105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rvp) = Big0; 19115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(rvp) = Big1; 19125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return; 19135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = s1 - s0 - 1; 19155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(k = 0; n > (1 << (kshift-2)) - 1; n >>= 1) 19165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k++; 19175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = Balloc(k); 19185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = b->x; 19195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = 0; 19205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = 0; 19215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef USE_LOCALE 19225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 0; decimalpoint[i+1]; ++i); 19235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 19245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(s1 > s0) { 19255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef USE_LOCALE 19265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*--s1 == decimalpoint[i]) { 19275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s1 -= i; 19285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) continue; 19295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 19315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*--s1 == '.') 19325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) continue; 19335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 19345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (n == ULbits) { 19355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x++ = L; 19365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = 0; 19375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = 0; 19385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L |= (hexdig[*s1] & 0x0f) << n; 19405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n += 4; 19415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *x++ = L; 19435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = n = x - b->x; 19445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = ULbits*n - hi0bits(L); 19455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nbits = Nbits; 19465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lostbits = 0; 19475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = b->x; 19485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (n > nbits) { 19495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n -= nbits; 19505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (any_on(b,n)) { 19515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lostbits = 1; 19525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = n - 1; 19535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (x[k>>kshift] & 1 << (k & kmask)) { 19545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lostbits = 2; 19555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k > 0 && any_on(b,k)) 19565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lostbits = 3; 19575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rshift(b, n); 19605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e += n; 19615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (n < nbits) { 19635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = nbits - n; 19645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = lshift(b, n); 19655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e -= n; 19665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = b->x; 19675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e > Emax) { 19695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ovfl: 19705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 19715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ovfl1: 19725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_ERRNO 19735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) errno = ERANGE; 19745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 19755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rvp) = Exp_mask; 19765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(rvp) = 0; 19775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return; 19785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) denorm = 0; 19805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e < emin) { 19815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) denorm = 1; 19825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = emin - e; 19835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (n >= nbits) { 19845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith /*{*/ 19855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch (rounding) { 19865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_near: 19875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (n == nbits && (n < 2 || any_on(b,n-1))) 19885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret_tiny; 19895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 19905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_up: 19915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!sign) 19925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret_tiny; 19935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 19945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_down: 19955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (sign) 19965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret_tiny; 19975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 19985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* } IEEE_Arith */ 19995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 20005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) retz: 20015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_ERRNO 20025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) errno = ERANGE; 20035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 20045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) retz1: 20055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rvp->d = 0.; 20065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return; 20075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = n - 1; 20095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (lostbits) 20105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lostbits = 1; 20115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (k > 0) 20125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lostbits = any_on(b,k); 20135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (x[k>>kshift] & 1 << (k & kmask)) 20145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lostbits |= 2; 20155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nbits -= n; 20165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rshift(b,n); 20175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e = emin; 20185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (lostbits) { 20205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) up = 0; 20215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(rounding) { 20225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_zero: 20235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 20245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_near: 20255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (lostbits & 2 20265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && (lostbits & 1) | (x[0] & 1)) 20275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) up = 1; 20285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 20295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_up: 20305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) up = 1 - sign; 20315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 20325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_down: 20335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) up = sign; 20345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (up) { 20365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = b->wds; 20375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = increment(b); 20385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = b->x; 20395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (denorm) { 20405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#if 0 20415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (nbits == Nbits - 1 20425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && x[nbits >> kshift] & 1 << (nbits & kmask)) 20435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) denorm = 0; /* not currently used */ 20445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 20455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (b->wds > k 20475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) || ((n = nbits & kmask) !=0 20485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && hi0bits(x[k-1]) < 32-n)) { 20495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rshift(b,1); 20505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (++e > Emax) 20515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ovfl; 20525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 20565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (denorm) 20575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rvp) = b->wds > 1 ? b->x[1] & ~0x100000 : 0; 20585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 20595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rvp) = (b->x[1] & ~0x100000) | ((e + 0x3ff + 52) << 20); 20605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(rvp) = b->x[0]; 20615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 20625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 20635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((j = e & 3)) { 20645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = b->x[0] & ((1 << j) - 1); 20655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rshift(b,j); 20665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k) { 20675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(rounding) { 20685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_up: 20695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!sign) 20705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) increment(b); 20715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 20725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_down: 20735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (sign) 20745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) increment(b); 20755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 20765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case Round_near: 20775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = 1 << (j-1); 20785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k & j && ((k & (j-1)) | lostbits)) 20795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) increment(b); 20805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e >>= 2; 20845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rvp) = b->x[1] | ((e + 65 + 13) << 24); 20855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(rvp) = b->x[0]; 20865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 20875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef VAX 20885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* The next two lines ignore swap of low- and high-order 2 bytes. */ 20895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* word0(rvp) = (b->x[1] & ~0x800000) | ((e + 129 + 55) << 23); */ 20905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* word1(rvp) = b->x[0]; */ 20915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rvp) = ((b->x[1] & ~0x800000) >> 16) | ((e + 129 + 55) << 7) | (b->x[1] << 16); 20925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(rvp) = (b->x[0] >> 16) | (b->x[0] << 16); 20935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 20945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 20955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 20965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*}!NO_HEX_FP*/ 20975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 20985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static int 20995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 21005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)dshift(b, p2) Bigint *b; int p2; 21015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 21025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)dshift(Bigint *b, int p2) 21035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 21045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 21055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int rv = hi0bits(b->x[b->wds-1]) - 4; 21065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (p2 > 0) 21075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv -= p2; 21085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return rv & kmask; 21095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 21105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 21115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static int 21125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)quorem 21135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 21145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (b, S) Bigint *b, *S; 21155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 21165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (Bigint *b, Bigint *S) 21175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 21185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 21195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int n; 21205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong *bx, *bxe, q, *sx, *sxe; 21215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef ULLong 21225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULLong borrow, carry, y, ys; 21235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 21245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong borrow, carry, y, ys; 21255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 21265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong si, z, zs; 21275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 21285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 21295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 21305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) n = S->wds; 21315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef DEBUG 21325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /*debug*/ if (b->wds > n) 21335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /*debug*/ Bug("oversize b in quorem"); 21345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 21355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (b->wds < n) 21365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 0; 21375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sx = S->x; 21385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sxe = sx + --n; 21395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bx = b->x; 21405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bxe = bx + n; 21415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) q = *bxe / (*sxe + 1); /* ensure q <= true quotient */ 21425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef DEBUG 21435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /*debug*/ if (q > 9) 21445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /*debug*/ Bug("oversized quotient in quorem"); 21455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 21465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (q) { 21475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = 0; 21485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = 0; 21495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 21505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef ULLong 21515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ys = *sx++ * (ULLong)q + carry; 21525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = ys >> 32; 21535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *bx - (ys & FFFFFFFF) - borrow; 21545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = y >> 32 & (ULong)1; 21555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *bx++ = y & FFFFFFFF; 21565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 21575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 21585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) si = *sx++; 21595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ys = (si & 0xffff) * q + carry; 21605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) zs = (si >> 16) * q + (ys >> 16); 21615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = zs >> 16; 21625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = (*bx & 0xffff) - (ys & 0xffff) - borrow; 21635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (y & 0x10000) >> 16; 21645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = (*bx >> 16) - (zs & 0xffff) - borrow; 21655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (z & 0x10000) >> 16; 21665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Storeinc(bx, z, y); 21675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 21685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ys = *sx++ * q + carry; 21695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = ys >> 16; 21705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *bx - (ys & 0xffff) - borrow; 21715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (y & 0x10000) >> 16; 21725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *bx++ = y & 0xffff; 21735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 21745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 21755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 21765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(sx <= sxe); 21775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!*bxe) { 21785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bx = b->x; 21795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(--bxe > bx && !*bxe) 21805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) --n; 21815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = n; 21825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 21835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 21845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (cmp(b, S) >= 0) { 21855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) q++; 21865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = 0; 21875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = 0; 21885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bx = b->x; 21895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sx = S->x; 21905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) do { 21915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef ULLong 21925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ys = *sx++ + carry; 21935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = ys >> 32; 21945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *bx - (ys & FFFFFFFF) - borrow; 21955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = y >> 32 & (ULong)1; 21965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *bx++ = y & FFFFFFFF; 21975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 21985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 21995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) si = *sx++; 22005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ys = (si & 0xffff) + carry; 22015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) zs = (si >> 16) + (ys >> 16); 22025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = zs >> 16; 22035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = (*bx & 0xffff) - (ys & 0xffff) - borrow; 22045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (y & 0x10000) >> 16; 22055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = (*bx >> 16) - (zs & 0xffff) - borrow; 22065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (z & 0x10000) >> 16; 22075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Storeinc(bx, z, y); 22085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 22095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ys = *sx++ + carry; 22105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) carry = ys >> 16; 22115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = *bx - (ys & 0xffff) - borrow; 22125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) borrow = (y & 0x10000) >> 16; 22135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *bx++ = y & 0xffff; 22145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 22155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 22165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 22175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(sx <= sxe); 22185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bx = b->x; 22195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bxe = bx + n; 22205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!*bxe) { 22215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(--bxe > bx && !*bxe) 22225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) --n; 22235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->wds = n; 22245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 22255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 22265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return q; 22275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 22285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 22295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_STRTOD_BIGCOMP 22305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 22315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static void 22325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)bigcomp 22335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 22345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (rv, s0, bc) 22355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) U *rv; CONST char *s0; BCinfo *bc; 22365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 22375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (U *rv, CONST char *s0, BCinfo *bc) 22385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 22395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 22405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b, *d; 22415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int b2, bbits, d2, dd, dig, dsign, i, j, nd, nd0, p2, p5, speccase; 22425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 22435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dsign = bc->dsign; 22445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nd = bc->nd; 22455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nd0 = bc->nd0; 22465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p5 = nd + bc->e0 - 1; 22475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dd = speccase = 0; 22485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 22495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (rv->d == 0.) { /* special case: value near underflow-to-zero */ 22505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* threshold was rounded to zero */ 22515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = i2b(1); 22525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p2 = Emin - P + 1; 22535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bbits = 1; 22545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 22555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rv) = (P+2) << Exp_shift; 22565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 22575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(rv) = 1; 22585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 22595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 0; 22605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 22615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc->rounding == 1) 22625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 22635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) { 22645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) speccase = 1; 22655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) --p2; 22665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dsign = 0; 22675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto have_i; 22685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 22695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 22705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 22715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 22725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = d2b(rv, &p2, &bbits); 22735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 22745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p2 -= bc->scale; 22755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 22765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* floor(log2(rv)) == bbits - 1 + p2 */ 22775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Check for denormal case. */ 22785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = P - bbits; 22795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i > (j = P - Emin - 1 + p2)) { 22805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Sudden_Underflow 22815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 22825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = i2b(1); 22835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p2 = Emin; 22845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = P - 1; 22855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 22865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rv) = (1 + bc->scale) << Exp_shift; 22875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 22885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(rv) = Exp_msk1; 22895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 22905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(rv) = 0; 22915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 22925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = j; 22935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 22945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 22955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 22965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc->rounding != 1) { 22975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i > 0) 22985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = lshift(b, i); 22995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dsign) 23005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = increment(b); 23015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 23035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 23045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) { 23055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = lshift(b, ++i); 23065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->x[0] |= 1; 23075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 23095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) have_i: 23105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 23115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) p2 -= p5 + i; 23125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d = i2b(1); 23135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Arrange for convenient computation of quotients: 23145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * shift left if necessary so divisor has 4 leading 0 bits. 23155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 23165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (p5 > 0) 23175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d = pow5mult(d, p5); 23185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (p5 < 0) 23195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = pow5mult(b, -p5); 23205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (p2 > 0) { 23215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b2 = p2; 23225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d2 = 0; 23235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 23255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b2 = 0; 23265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d2 = -p2; 23275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = dshift(d, d2); 23295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((b2 += i) > 0) 23305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = lshift(b, b2); 23315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((d2 += i) > 0) 23325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) d = lshift(d, d2); 23335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 23345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Now b/d = exactly half-way between the two floating-point values */ 23355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* on either side of the input string. Compute first digit of b/d. */ 23365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 23375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(dig = quorem(b,d))) { 23385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = multadd(b, 10, 0); /* very unlikely */ 23395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dig = quorem(b,d); 23405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 23425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Compare b/d with s0 */ 23435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 23445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 0; i < nd0; ) { 23455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((dd = s0[i++] - '0' - dig)) 23465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 23475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!b->x[0] && b->wds == 1) { 23485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i < nd) 23495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dd = 1; 23505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 23515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = multadd(b, 10, 0); 23535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dig = quorem(b,d); 23545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(j = bc->dp1; i++ < nd;) { 23565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((dd = s0[j++] - '0' - dig)) 23575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 23585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!b->x[0] && b->wds == 1) { 23595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i < nd) 23605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dd = 1; 23615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 23625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = multadd(b, 10, 0); 23645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dig = quorem(b,d); 23655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (b->x[0] || b->wds > 1) 23675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dd = -1; 23685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ret: 23695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 23705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(d); 23715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 23725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc->rounding != 1) { 23735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dd < 0) { 23745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc->rounding == 0) { 23755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!dsign) 23765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto retlow1; 23775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (dsign) 23795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto rethi1; 23805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (dd > 0) { 23825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc->rounding == 0) { 23835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dsign) 23845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto rethi1; 23855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret1; 23865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!dsign) 23885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto rethi1; 23895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(rv) += 2.*ulp(rv); 23905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 23925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc->inexact = 0; 23935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dsign) 23945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto rethi1; 23955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 23975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 23985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 23995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (speccase) { 24005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dd <= 0) 24015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv->d = 0.; 24025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 24035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (dd < 0) { 24045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!dsign) /* does not happen for round-near */ 24055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)retlow1: 24065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(rv) -= ulp(rv); 24075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 24085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (dd > 0) { 24095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dsign) { 24105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rethi1: 24115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(rv) += ulp(rv); 24125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 24135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 24145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 24155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Exact half-way case: apply round-even rule. */ 24165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (word1(rv) & 1) { 24175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dsign) 24185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto rethi1; 24195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto retlow1; 24205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 24215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 24225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 24235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 24245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ret1: 24255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 24265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return; 24275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 24285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* NO_STRTOD_BIGCOMP */ 24295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 24305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) double 24315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)strtod 24325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 24335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (s00, se) CONST char *s00; char **se; 24345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 24355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (CONST char *s00, char **se) 24365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 24375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 24385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, e, e1; 24395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int esign, i, j, k, nd, nd0, nf, nz, nz0, sign; 24405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) CONST char *s, *s0, *s1; 24415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) double aadj, aadj1; 24425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Long L; 24435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) U aadj2, adj, rv, rv0; 24445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong y, z; 24455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) BCinfo bc; 24465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *bb, *bb1, *bd, *bd0, *bs, *delta; 24475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 24485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int oldinexact; 24495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 24505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS /*{*/ 24515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */ 24525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.rounding = Flt_Rounds; 24535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /*}{*/ 24545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.rounding = 1; 24555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(fegetround()) { 24565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case FE_TOWARDZERO: bc.rounding = 0; break; 24575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case FE_UPWARD: bc.rounding = 2; break; 24585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case FE_DOWNWARD: bc.rounding = 3; 24595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 24605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*}}*/ 24615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*}*/ 24625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef USE_LOCALE 24635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) CONST char *s2; 24645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 24655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 24665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sign = nz0 = nz = bc.dplen = bc.uflchk = 0; 24675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) = 0.; 24685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(s = s00;;s++) switch(*s) { 24695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '-': 24705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sign = 1; 24715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* no break */ 24725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '+': 24735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*++s) 24745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto break2; 24755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* no break */ 24765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 0: 24775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret0; 24785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '\t': 24795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '\n': 24805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '\v': 24815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '\f': 24825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '\r': 24835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case ' ': 24845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) continue; 24855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) default: 24865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto break2; 24875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 24885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break2: 24895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*s == '0') { 24905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_HEX_FP /*{*/ 24915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(s[1]) { 24925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 'x': 24935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 'X': 24945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 24955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) gethex(&s, &rv, bc.rounding, sign); 24965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 24975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) gethex(&s, &rv, 1, sign); 24985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 24995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 25005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*}*/ 25025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nz0 = 1; 25035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(*++s == '0') ; 25045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!*s) 25055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 25065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s0 = s; 25085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = z = 0; 25095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++) 25105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (nd < 9) 25115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = 10*y + c - '0'; 25125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (nd < 16) 25135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = 10*z + c - '0'; 25145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nd0 = nd; 25155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.dp0 = bc.dp1 = s - s0; 25165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef USE_LOCALE 25175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s1 = localeconv()->decimal_point; 25185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (c == *s1) { 25195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = '.'; 25205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*++s1) { 25215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s2 = s; 25225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(;;) { 25235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*++s2 != *s1) { 25245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = 0; 25255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 25265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!*++s1) { 25285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s = s2; 25295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 25305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 25355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (c == '.') { 25365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = *++s; 25375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.dp1 = s - s0; 25385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.dplen = bc.dp1 - bc.dp0; 25395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!nd) { 25405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(; c == '0'; c = *++s) 25415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nz++; 25425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (c > '0' && c <= '9') { 25435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s0 = s; 25445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nf += nz; 25455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nz = 0; 25465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto have_dig; 25475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto dig_done; 25495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(; c >= '0' && c <= '9'; c = *++s) { 25515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) have_dig: 25525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nz++; 25535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (c -= '0') { 25545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nf += nz; 25555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 1; i < nz; i++) 25565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (nd++ < 9) 25575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y *= 10; 25585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (nd <= DBL_DIG + 1) 25595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z *= 10; 25605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (nd++ < 9) 25615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = 10*y + c; 25625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (nd <= DBL_DIG + 1) 25635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = 10*z + c; 25645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nz = 0; 25655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dig_done: 25695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e = 0; 25705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (c == 'e' || c == 'E') { 25715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!nd && !nz && !nz0) { 25725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret0; 25735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s00 = s; 25755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) esign = 0; 25765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(c = *++s) { 25775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '-': 25785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) esign = 1; 25795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case '+': 25805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = *++s; 25815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 25825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (c >= '0' && c <= '9') { 25835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(c == '0') 25845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) c = *++s; 25855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (c > '0' && c <= '9') { 25865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = c - '0'; 25875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s1 = s; 25885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while((c = *++s) >= '0' && c <= '9') 25895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = 10*L + c - '0'; 25905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s - s1 > 8 || L > 19999) 25915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Avoid confusion from exponents 25925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * so large that e might overflow. 25935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 25945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e = 19999; /* safe for 16 bit ints */ 25955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 25965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e = (int)L; 25975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (esign) 25985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e = -e; 25995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 26015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e = 0; 26025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 26045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s = s00; 26055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!nd) { 26075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!nz && !nz0) { 26085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef INFNAN_CHECK 26095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Check for Nan and Infinity */ 26105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!bc.dplen) 26115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(c) { 26125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 'i': 26135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 'I': 26145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (match(&s,"nf")) { 26155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) --s; 26165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!match(&s,"inity")) 26175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ++s; 26185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = 0x7ff00000; 26195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = 0; 26205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 26215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 26235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 'n': 26245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 'N': 26255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (match(&s, "an")) { 26265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = NAN_WORD0; 26275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = NAN_WORD1; 26285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef No_Hex_NaN 26295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*s == '(') /*)*/ 26305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) hexnan(&rv, &s); 26315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 26325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 26335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* INFNAN_CHECK */ 26365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ret0: 26375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s = s00; 26385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sign = 0; 26395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 26415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.e0 = e1 = e -= nf; 26435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 26445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Now we have nd0 digits, starting at s0, followed by a 26455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * decimal point, followed by nd-nd0 digits. The number we're 26465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * after is the integer represented by those digits times 26475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 10**e */ 26485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 26495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!nd0) 26505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nd0 = nd; 26515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1; 26525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) = y; 26535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k > 9) { 26545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 26555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k > DBL_DIG) 26565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) oldinexact = get_inexact(); 26575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 26585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) = tens[k - 9] * dval(&rv) + z; 26595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd0 = 0; 26615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (nd <= DBL_DIG 26625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef RND_PRODQUOT 26635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Honor_FLT_ROUNDS 26645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && Flt_Rounds == 1 26655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 26665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 26675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ) { 26685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!e) 26695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 26705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e > 0) { 26715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e <= Ten_pmax) { 26725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef VAX 26735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto vax_ovfl_check; 26745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 26755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 26765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* round correctly FLT_ROUNDS = 2 or 3 */ 26775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (sign) { 26785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv.d = -rv.d; 26795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sign = 0; 26805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 26825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* rv = */ rounded_product(dval(&rv), tens[e]); 26835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 26845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 26855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = DBL_DIG - nd; 26875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e <= Ten_pmax + i) { 26885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* A fancier test would sometimes let us do 26895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * this for larger i values. 26905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 26915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 26925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* round correctly FLT_ROUNDS = 2 or 3 */ 26935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (sign) { 26945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv.d = -rv.d; 26955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sign = 0; 26965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 26975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 26985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e -= i; 26995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) *= tens[i]; 27005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef VAX 27015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* VAX exponent range is so narrow we must 27025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * worry about overflow here... 27035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 27045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) vax_ovfl_check: 27055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) -= P*Exp_msk1; 27065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* rv = */ rounded_product(dval(&rv), tens[e]); 27075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((word0(&rv) & Exp_mask) 27085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) 27095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ovfl; 27105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) += P*Exp_msk1; 27115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 27125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* rv = */ rounded_product(dval(&rv), tens[e]); 27135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 27145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 27155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 27165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 27175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Inaccurate_Divide 27185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (e >= -Ten_pmax) { 27195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 27205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* round correctly FLT_ROUNDS = 2 or 3 */ 27215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (sign) { 27225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rv.d = -rv.d; 27235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sign = 0; 27245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 27255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 27265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* rv = */ rounded_quotient(dval(&rv), tens[-e]); 27275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 27285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 27295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 27305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 27315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e1 += nd - k; 27325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 27335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 27345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 27355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.inexact = 1; 27365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k <= DBL_DIG) 27375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) oldinexact = get_inexact(); 27385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 27395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 27405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.scale = 0; 27415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 27425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 27435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.rounding >= 2) { 27445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (sign) 27455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.rounding = bc.rounding == 2 ? 0 : 2; 27465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 27475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.rounding != 2) 27485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.rounding = 0; 27495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 27505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 27515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*IEEE_Arith*/ 27525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 27535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Get starting approximation = rv * 10**e1 */ 27545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 27555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 > 0) { 27565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((i = e1 & 15)) 27575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) *= tens[i]; 27585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 &= ~15) { 27595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 > DBL_MAX_10_EXP) { 27605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ovfl: 27615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_ERRNO 27625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) errno = ERANGE; 27635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 27645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Can't trust HUGE_VAL */ 27655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 27665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 27675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(bc.rounding) { 27685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 0: /* toward 0 */ 27695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 3: /* toward -infinity */ 27705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = Big0; 27715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = Big1; 27725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 27735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) default: 27745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = Exp_mask; 27755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = 0; 27765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 27775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /*Honor_FLT_ROUNDS*/ 27785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = Exp_mask; 27795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = 0; 27805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Honor_FLT_ROUNDS*/ 27815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 27825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* set overflow bit */ 27835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv0) = 1e300; 27845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv0) *= dval(&rv0); 27855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 27865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /*IEEE_Arith*/ 27875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = Big0; 27885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = Big1; 27895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*IEEE_Arith*/ 27905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 27915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 27925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e1 >>= 4; 27935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(j = 0; e1 > 1; j++, e1 >>= 1) 27945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 & 1) 27955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) *= bigtens[j]; 27965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* The last multiplication could overflow. */ 27975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) -= P*Exp_msk1; 27985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) *= bigtens[j]; 27995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((z = word0(&rv) & Exp_mask) 28005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) > Exp_msk1*(DBL_MAX_EXP+Bias-P)) 28015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ovfl; 28025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) { 28035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* set to largest number */ 28045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* (Can't trust DBL_MAX) */ 28055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = Big0; 28065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = Big1; 28075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 28095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) += P*Exp_msk1; 28105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (e1 < 0) { 28135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e1 = -e1; 28145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((i = e1 & 15)) 28155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) /= tens[i]; 28165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 >>= 4) { 28175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 >= 1 << n_bigtens) 28185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto undfl; 28195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 28205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 & Scale_Bit) 28215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.scale = 2*P; 28225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(j = 0; e1 > 0; j++, e1 >>= 1) 28235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 & 1) 28245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) *= tinytens[j]; 28255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.scale && (j = 2*P + 1 - ((word0(&rv) & Exp_mask) 28265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) >> Exp_shift)) > 0) { 28275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* scaled rv is denormal; clear j low bits */ 28285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j >= 32) { 28295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = 0; 28305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j >= 53) 28315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = (P+2)*Exp_msk1; 28325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 28335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) &= 0xffffffff << (j-32); 28345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 28365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) &= 0xffffffff << j; 28375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 28395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(j = 0; e1 > 1; j++, e1 >>= 1) 28405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e1 & 1) 28415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) *= tinytens[j]; 28425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* The last multiplication could underflow. */ 28435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv0) = dval(&rv); 28445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) *= tinytens[j]; 28455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!dval(&rv)) { 28465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) = 2.*dval(&rv0); 28475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) *= tinytens[j]; 28485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 28495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!dval(&rv)) { 28505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) undfl: 28515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) = 0.; 28525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_ERRNO 28535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) errno = ERANGE; 28545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 28555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 28565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Avoid_Underflow 28585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = Tiny0; 28595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = Tiny1; 28605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* The refinement below will clean 28615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * this approximation up. 28625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 28635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 28655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 28685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Now the hard part -- adjusting rv to the correct value.*/ 28695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 28705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Put digits into bd: true value = bd * 10^e */ 28715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 28725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.nd = nd; 28735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_STRTOD_BIGCOMP 28745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.nd0 = nd0; /* Only needed if nd > strtod_diglim, but done here */ 28755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* to silence an erroneous warning about bc.nd0 */ 28765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* possibly not being initialized. */ 28775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (nd > strtod_diglim) { 28785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* ASSERT(strtod_diglim >= 18); 18 == one more than the */ 28795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* minimum number of decimal digits to distinguish double values */ 28805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* in IEEE arithmetic. */ 28815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = j = 18; 28825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i > nd0) 28835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j += bc.dplen; 28845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(;;) { 28855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (--j <= bc.dp1 && j >= bc.dp0) 28865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = bc.dp0 - 1; 28875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s0[j] != '0') 28885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 28895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) --i; 28905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 28915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e += nd - i; 28925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nd = i; 28935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (nd0 > nd) 28945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) nd0 = nd; 28955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (nd < 9) { /* must recompute y */ 28965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = 0; 28975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 0; i < nd0; ++i) 28985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = 10*y + s0[i] - '0'; 28995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(j = bc.dp1; i < nd; ++i) 29005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = 10*y + s0[j++] - '0'; 29015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 29025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 29035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 29045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd0 = s2b(s0, nd0, nd, y, bc.dplen); 29055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 29065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(;;) { 29075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd = Balloc(bd0->k); 29085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bcopy(bd, bd0); 29095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bb = d2b(&rv, &bbe, &bbbits); /* rv = bb * 2^bbe */ 29105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bs = i2b(1); 29115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 29125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (e >= 0) { 29135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bb2 = bb5 = 0; 29145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd2 = bd5 = e; 29155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 29165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 29175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bb2 = bb5 = -e; 29185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd2 = bd5 = 0; 29195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 29205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bbe >= 0) 29215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bb2 += bbe; 29225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 29235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd2 -= bbe; 29245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bs2 = bb2; 29255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 29265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.rounding != 1) 29275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bs2++; 29285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 29295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 29305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = bbe - bc.scale; 29315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = j + bbbits - 1; /* logb(rv) */ 29325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i < Emin) /* denormal */ 29335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j += P - Emin; 29345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 29355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = P + 1 - bbbits; 29365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /*Avoid_Underflow*/ 29375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Sudden_Underflow 29385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 29395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3); 29405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 29415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = P + 1 - bbbits; 29425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 29435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /*Sudden_Underflow*/ 29445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = bbe; 29455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = j + bbbits - 1; /* logb(rv) */ 29465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i < Emin) /* denormal */ 29475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j += P - Emin; 29485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 29495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = P + 1 - bbbits; 29505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Sudden_Underflow*/ 29515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Avoid_Underflow*/ 29525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bb2 += j; 29535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd2 += j; 29545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 29555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd2 += bc.scale; 29565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 29575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = bb2 < bd2 ? bb2 : bd2; 29585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i > bs2) 29595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = bs2; 29605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i > 0) { 29615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bb2 -= i; 29625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd2 -= i; 29635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bs2 -= i; 29645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 29655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bb5 > 0) { 29665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bs = pow5mult(bs, bb5); 29675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bb1 = mult(bs, bb); 29685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(bb); 29695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bb = bb1; 29705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 29715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bb2 > 0) 29725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bb = lshift(bb, bb2); 29735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bd5 > 0) 29745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd = pow5mult(bd, bd5); 29755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bd2 > 0) 29765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bd = lshift(bd, bd2); 29775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bs2 > 0) 29785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bs = lshift(bs, bs2); 29795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) delta = diff(bb, bd); 29805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.dsign = delta->sign; 29815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) delta->sign = 0; 29825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = cmp(delta, bs); 29835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_STRTOD_BIGCOMP 29845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.nd > nd && i <= 0) { 29855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.dsign) 29865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; /* Must use bigcomp(). */ 29875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 29885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.rounding != 1) { 29895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i < 0) 29905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 29915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 29925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 29935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 29945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) { 29955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.nd = nd; 29965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = -1; /* Discarded digits make delta smaller. */ 29975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 29985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 29995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 30005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 30015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.rounding != 1) { 30025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i < 0) { 30035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Error is less than an ulp */ 30045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!delta->x[0] && delta->wds <= 1) { 30055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* exact */ 30065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 30075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.inexact = 0; 30085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 30095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 30105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.rounding) { 30125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.dsign) { 30135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = 1.; 30145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto apply_adj; 30155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (!bc.dsign) { 30185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = -1.; 30195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!word1(&rv) 30205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && !(word0(&rv) & Frac_mask)) { 30215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = word0(&rv) & Exp_mask; 30225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 30235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!bc.scale || y > 2*P*Exp_msk1) 30245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 30255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (y) 30265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 30275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) { 30285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) delta = lshift(delta,Log2P); 30295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (cmp(delta, bs) <= 0) 30305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = -0.5; 30315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) apply_adj: 30345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 30355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.scale && (y = word0(&rv) & Exp_mask) 30365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) <= 2*P*Exp_msk1) 30375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&adj) += (2*P+1)*Exp_msk1 - y; 30385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 30395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Sudden_Underflow 30405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((word0(&rv) & Exp_mask) <= 30415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) P*Exp_msk1) { 30425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) += P*Exp_msk1; 30435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += adj.d*ulp(dval(&rv)); 30445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) -= P*Exp_msk1; 30455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 30475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Sudden_Underflow*/ 30485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Avoid_Underflow*/ 30495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += adj.d*ulp(&rv); 30505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 30525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = ratio(delta, bs); 30545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (adj.d < 1.) 30555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = 1.; 30565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (adj.d <= 0x7ffffffe) { 30575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* adj = rounding ? ceil(adj) : floor(adj); */ 30585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = adj.d; 30595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (y != adj.d) { 30605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!((bc.rounding>>1) ^ bc.dsign)) 30615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y++; 30625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = y; 30635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 30665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.scale && (y = word0(&rv) & Exp_mask) <= 2*P*Exp_msk1) 30675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&adj) += (2*P+1)*Exp_msk1 - y; 30685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 30695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Sudden_Underflow 30705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) { 30715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) += P*Exp_msk1; 30725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d *= ulp(dval(&rv)); 30735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.dsign) 30745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += adj.d; 30755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 30765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) -= adj.d; 30775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) -= P*Exp_msk1; 30785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto cont; 30795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Sudden_Underflow*/ 30815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Avoid_Underflow*/ 30825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d *= ulp(&rv); 30835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.dsign) { 30845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (word0(&rv) == Big0 && word1(&rv) == Big1) 30855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ovfl; 30865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += adj.d; 30875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 30895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) -= adj.d; 30905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto cont; 30915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 30925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Honor_FLT_ROUNDS*/ 30935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 30945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i < 0) { 30955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Error is less than half an ulp -- check for 30965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * special case of mantissa a power of two. 30975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 30985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.dsign || word1(&rv) || word0(&rv) & Bndry_mask 30995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 31005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 31015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) || (word0(&rv) & Exp_mask) <= (2*P+1)*Exp_msk1 31025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 31035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) || (word0(&rv) & Exp_mask) <= Exp_msk1 31045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 31055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 31065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ) { 31075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 31085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!delta->x[0] && delta->wds <= 1) 31095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.inexact = 0; 31105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 31115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 31125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!delta->x[0] && delta->wds <= 1) { 31145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* exact result */ 31155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 31165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.inexact = 0; 31175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 31185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 31195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) delta = lshift(delta,Log2P); 31215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (cmp(delta, bs) > 0) 31225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto drop_down; 31235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 31245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i == 0) { 31265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* exactly half-way between */ 31275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.dsign) { 31285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((word0(&rv) & Bndry_mask1) == Bndry_mask1 31295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && word1(&rv) == ( 31305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 31315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (bc.scale && (y = word0(&rv) & Exp_mask) <= 2*P*Exp_msk1) 31325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ? (0xffffffff & (0xffffffff << (2*P+1-(y>>Exp_shift)))) : 31335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 31345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 0xffffffff)) { 31355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /*boundary case -- increment exponent*/ 31365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = (word0(&rv) & Exp_mask) 31375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) + Exp_msk1 31385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 31395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) | Exp_msk1 >> 4 31405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 31415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ; 31425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = 0; 31435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 31445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.dsign = 0; 31455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 31465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 31475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (!(word0(&rv) & Bndry_mask) && !word1(&rv)) { 31505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) drop_down: 31515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* boundary case -- decrement exponent */ 31525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Sudden_Underflow /*{{*/ 31535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = word0(&rv) & Exp_mask; 31545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 31555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (L < Exp_msk1) 31565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 31575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 31585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (L <= (bc.scale ? (2*P+1)*Exp_msk1 : Exp_msk1)) 31595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 31605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (L <= Exp_msk1) 31615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Avoid_Underflow*/ 31625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*IBM*/ 31635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) { 31645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.nd >nd) { 31655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.uflchk = 1; 31665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 31675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto undfl; 31695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L -= Exp_msk1; 31715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /*Sudden_Underflow}{*/ 31725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 31735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.scale) { 31745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = word0(&rv) & Exp_mask; 31755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (L <= (2*P+1)*Exp_msk1) { 31765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (L > (P+2)*Exp_msk1) 31775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* round even ==> */ 31785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* accept rv */ 31795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 31805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* rv = smallest denormal */ 31815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.nd >nd) { 31825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.uflchk = 1; 31835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 31845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto undfl; 31865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Avoid_Underflow*/ 31895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = (word0(&rv) & Exp_mask) - Exp_msk1; 31905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Sudden_Underflow}}*/ 31915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = L | Bndry_mask1; 31925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = 0xffffffff; 31935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 31945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto cont; 31955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 31965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 31975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 31985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 31995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef ROUND_BIASED 32005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(word1(&rv) & LSB)) 32015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 32025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 32035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.dsign) 32045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += ulp(&rv); 32055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef ROUND_BIASED 32065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 32075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) -= ulp(&rv); 32085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 32095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!dval(&rv)) { 32105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.nd >nd) { 32115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.uflchk = 1; 32125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 32135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto undfl; 32155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 32175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 32195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.dsign = 1 - bc.dsign; 32205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 32215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 32225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 32235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((aadj = ratio(delta, bs)) <= 2.) { 32255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.dsign) 32265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj = aadj1 = 1.; 32275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (word1(&rv) || word0(&rv) & Bndry_mask) { 32285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 32295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (word1(&rv) == Tiny1 && !word0(&rv)) { 32305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.nd >nd) { 32315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.uflchk = 1; 32325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 32335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto undfl; 32355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 32375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj = 1.; 32385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 = -1.; 32395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 32415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* special case -- power of FLT_RADIX to be */ 32425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* rounded down... */ 32435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 32445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (aadj < 2./FLT_RADIX) 32455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj = 1./FLT_RADIX; 32465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 32475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj *= 0.5; 32485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 = -aadj; 32495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 32525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj *= 0.5; 32535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 = bc.dsign ? aadj : -aadj; 32545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Check_FLT_ROUNDS 32555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(bc.rounding) { 32565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 2: /* towards +infinity */ 32575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 -= 0.5; 32585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 32595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 0: /* towards 0 */ 32605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 3: /* towards -infinity */ 32615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 += 0.5; 32625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 32645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (Flt_Rounds == 0) 32655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 += 0.5; 32665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Check_FLT_ROUNDS*/ 32675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) y = word0(&rv) & Exp_mask; 32695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 32705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Check for overflow */ 32715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 32725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) { 32735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv0) = dval(&rv); 32745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) -= P*Exp_msk1; 32755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = aadj1 * ulp(&rv); 32765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += adj.d; 32775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((word0(&rv) & Exp_mask) >= 32785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Exp_msk1*(DBL_MAX_EXP+Bias-P)) { 32795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (word0(&rv0) == Big0 && word1(&rv0) == Big1) 32805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ovfl; 32815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = Big0; 32825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = Big1; 32835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto cont; 32845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 32865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) += P*Exp_msk1; 32875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 32895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 32905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.scale && y <= 2*P*Exp_msk1) { 32915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (aadj <= 0x7fffffff) { 32925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((z = aadj) <= 0) 32935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = 1; 32945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj = z; 32955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 = bc.dsign ? aadj : -aadj; 32965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 32975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&aadj2) = aadj1; 32985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&aadj2) += (2*P+1)*Exp_msk1 - y; 32995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 = dval(&aadj2); 33005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = aadj1 * ulp(&rv); 33025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += adj.d; 33035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 33045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Sudden_Underflow 33055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) { 33065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv0) = dval(&rv); 33075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) += P*Exp_msk1; 33085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = aadj1 * ulp(&rv); 33095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += adj.d; 33105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 33115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((word0(&rv) & Exp_mask) < P*Exp_msk1) 33125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 33135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((word0(&rv) & Exp_mask) <= P*Exp_msk1) 33145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 33155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) { 33165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (word0(&rv0) == Tiny0 33175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && word1(&rv0) == Tiny1) { 33185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.nd >nd) { 33195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bc.uflchk = 1; 33205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 33215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto undfl; 33235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) = Tiny0; 33255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv) = Tiny1; 33265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto cont; 33275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 33295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv) -= P*Exp_msk1; 33305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 33325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = aadj1 * ulp(&rv); 33335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += adj.d; 33345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /*Sudden_Underflow*/ 33365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Compute adj so that the IEEE rounding rules will 33375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * correctly round rv + adj in some half-way cases. 33385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * If rv * ulp(rv) is denormalized (i.e., 33395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid 33405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * trouble from bits lost to denormalization; 33415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * example: 1.2e-307 . 33425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 33435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (y <= (P-1)*Exp_msk1 && aadj > 1.) { 33445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 = (double)(int)(aadj + 0.5); 33455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!bc.dsign) 33465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj1 = -aadj1; 33475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) adj.d = aadj1 * ulp(&rv); 33495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) += adj.d; 33505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Sudden_Underflow*/ 33515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Avoid_Underflow*/ 33525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) z = word0(&rv) & Exp_mask; 33545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef SET_INEXACT 33555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.nd == nd) { 33565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 33575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!bc.scale) 33585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 33595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (y == z) { 33605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Can we stop now? */ 33615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = (Long)aadj; 33625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) aadj -= L; 33635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* The tolerances below are conservative. */ 33645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.dsign || word1(&rv) || word0(&rv) & Bndry_mask) { 33655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (aadj < .4999999 || aadj > .5000001) 33665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 33675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (aadj < .4999999/FLT_RADIX) 33695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 33705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 33735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) cont: 33745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(bb); 33755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(bd); 33765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(bs); 33775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(delta); 33785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(bb); 33805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(bd); 33815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(bs); 33825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(bd0); 33835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(delta); 33845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_STRTOD_BIGCOMP 33855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.nd > nd) 33865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bigcomp(&rv, s0, &bc); 33875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 33885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 33895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.inexact) { 33905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!oldinexact) { 33915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv0) = Exp_1 + (70 << Exp_shift); 33925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv0) = 0; 33935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv0) += 1.; 33945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 33965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (!oldinexact) 33975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) clear_inexact(); 33985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 33995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Avoid_Underflow 34005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.scale) { 34015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&rv0) = Exp_1 - 2*P*Exp_msk1; 34025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&rv0) = 0; 34035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv) *= dval(&rv0); 34045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef NO_ERRNO 34055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* try to avoid the bug of testing an 8087 register value */ 34065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 34075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(word0(&rv) & Exp_mask)) 34085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 34095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (word0(&rv) == 0 && word1(&rv) == 0) 34105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 34115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) errno = ERANGE; 34125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 34135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 34145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /* Avoid_Underflow */ 34155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 34165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (bc.inexact && !(word0(&rv) & Exp_mask)) { 34175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* set underflow bit */ 34185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv0) = 1e-300; 34195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&rv0) *= dval(&rv0); 34205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 34215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 34225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ret: 34235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (se) 34245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *se = (char *)s; 34255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return sign ? -dval(&rv) : dval(&rv); 34265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 34275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 34285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef MULTIPLE_THREADS 34295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static char *dtoa_result; 34305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 34315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 34325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static char * 34335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 34345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)rv_alloc(i) int i; 34355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 34365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)rv_alloc(int i) 34375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 34385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 34395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int j, k, *r; 34405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 34415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = sizeof(ULong); 34425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(k = 0; 34435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) sizeof(Bigint) - sizeof(ULong) - sizeof(int) + j <= (size_t)i; 34445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j <<= 1) 34455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k++; 34465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) r = (int*)Balloc(k); 34475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *r = k; 34485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return 34495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef MULTIPLE_THREADS 34505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dtoa_result = 34515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 34525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (char *)(r+1); 34535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 34545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 34555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) static char * 34565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 34575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)nrv_alloc(s, rve, n) char *s, **rve; int n; 34585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 34595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)nrv_alloc(CONST char *s, char **rve, int n) 34605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 34615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 34625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) char *rv, *t; 34635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 34645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) t = rv = rv_alloc(n); 34655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while((*t = *s++)) t++; 34665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (rve) 34675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *rve = t; 34685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return rv; 34695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 34705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 34715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* freedtoa(s) must be used to free values s returned by dtoa 34725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * when MULTIPLE_THREADS is #defined. It should be used in all cases, 34735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * but for consistency with earlier versions of dtoa, it is optional 34745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * when MULTIPLE_THREADS is not defined. 34755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 34765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 34775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) void 34785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 34795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)freedtoa(s) char *s; 34805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 34815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)freedtoa(char *s) 34825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 34835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 34845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b = (Bigint *)((int *)s - 1); 34855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b->maxwds = 1 << (b->k = *(int*)b); 34865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 34875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef MULTIPLE_THREADS 34885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s == dtoa_result) 34895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dtoa_result = 0; 34905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 34915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 34925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 34935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)/* dtoa for IEEE arithmetic (dmg): convert double to ASCII string. 34945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 34955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Inspired by "How to Print Floating-Point Numbers Accurately" by 34965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 112-126]. 34975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 34985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Modifications: 34995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 1. Rather than iterating, we use a simple numeric overestimate 35005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * to determine k = floor(log10(d)). We scale relevant 35015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * quantities using O(log2(k)) rather than O(k) multiplications. 35025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 2. For some modes > 2 (corresponding to ecvt and fcvt), we don't 35035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * try to generate digits strictly left to right. Instead, we 35045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * compute with fewer bits and propagate the carry if necessary 35055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * when rounding the final digit up. This is often faster. 35065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 3. Under the assumption that input will be rounded nearest, 35075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22. 35085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * That is, we allow equality in stopping tests when the 35095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * round-nearest rule will give the same floating-point value 35105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * as would satisfaction of the stopping test with strict 35115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * inequality. 35125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 4. We remove common factors of powers of 2 from relevant 35135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * quantities. 35145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 5. When converting floating-point integers less than 1e16, 35155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * we use floating-point arithmetic rather than resorting 35165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * to multiple-precision integers. 35175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 6. When asked to produce fewer than 15 digits, we first try 35185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * to get by with floating-point arithmetic; we resort to 35195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * multiple-precision integer arithmetic only if we cannot 35205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * guarantee that the floating-point calculation has given 35215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * the correctly rounded result. For k requested digits and 35225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * "uniformly" distributed input, the probability is 35235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * something like 10^(k-15) that we must resort to the Long 35245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * calculation. 35255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 35265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 35275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) char * 35285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)dtoa 35295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef KR_headers 35305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (dd, mode, ndigits, decpt, sign, rve) 35315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) double dd; int mode, ndigits, *decpt, *sign; char **rve; 35325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 35335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) (double dd, int mode, int ndigits, int *decpt, int *sign, char **rve) 35345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 35355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){ 35365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Arguments ndigits, decpt, sign are similar to those 35375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) of ecvt and fcvt; trailing zeros are suppressed from 35385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) the returned string. If not null, *rve is set to point 35395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) to the end of the return value. If d is +-Infinity or NaN, 35405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) then *decpt is set to 9999. 35415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 35425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mode: 35435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 0 ==> shortest string that yields d when read in 35445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) and rounded to nearest. 35455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1 ==> like 0, but with Steele & White stopping rule; 35465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) e.g. with IEEE P754 arithmetic , mode 0 gives 35475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1e23 whereas mode 1 gives 9.999999999999999e22. 35485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 2 ==> max(1,ndigits) significant digits. This gives a 35495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return value similar to that of ecvt, except 35505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) that trailing zeros are suppressed. 35515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 3 ==> through ndigits past the decimal point. This 35525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) gives a return value similar to that from fcvt, 35535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) except that trailing zeros are suppressed, and 35545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ndigits can be negative. 35555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 4,5 ==> similar to 2 and 3, respectively, but (in 35565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) round-nearest mode) with the tests of mode 0 to 35575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) possibly return a shorter string that rounds to d. 35585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) With IEEE arithmetic and compilation with 35595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) -DHonor_FLT_ROUNDS, modes 4 and 5 behave the same 35605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) as modes 2 and 3 when FLT_ROUNDS != 1. 35615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 6-9 ==> Debugging modes similar to mode - 4: don't try 35625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) fast floating-point estimate (if applicable). 35635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 35645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Values of mode other than 0-9 are treated as mode 0. 35655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 35665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Sufficient space is allocated to the return value 35675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) to hold the suppressed trailing zeros. 35685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 35695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 35705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1, 35715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j, j1, k, k0, k_check, leftright, m2, m5, s2, s5, 35725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) spec_case, try_quick; 35735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Long L; 35745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 35755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int denorm; 35765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ULong x; 35775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 35785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bigint *b, *b1, *delta, *mlo = NULL, *mhi, *S; 35795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) U d2, eps, u; 35805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) double ds; 35815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) char *s, *s0; 35825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 35835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int inexact, oldinexact; 35845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 35855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS /*{*/ 35865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) int Rounding; 35875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Trust_FLT_ROUNDS /*{{ only define this if FLT_ROUNDS really works! */ 35885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Rounding = Flt_Rounds; 35895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else /*}{*/ 35905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Rounding = 1; 35915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(fegetround()) { 35925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case FE_TOWARDZERO: Rounding = 0; break; 35935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case FE_UPWARD: Rounding = 2; break; 35945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case FE_DOWNWARD: Rounding = 3; 35955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 35965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*}}*/ 35975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*}*/ 35985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 35995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef MULTIPLE_THREADS 36005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dtoa_result) { 36015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) freedtoa(dtoa_result); 36025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dtoa_result = 0; 36035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 36045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 36065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) u.d = dd; 36075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (word0(&u) & Sign_bit) { 36085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* set sign for everything, including 0's and NaNs */ 36095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *sign = 1; 36105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&u) &= ~Sign_bit; /* clear sign bit */ 36115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 36125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 36135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *sign = 0; 36145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 36155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#if defined(IEEE_Arith) + defined(VAX) 36165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 36175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((word0(&u) & Exp_mask) == Exp_mask) 36185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 36195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (word0(&u) == 0x8000) 36205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) { 36225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Infinity or NaN */ 36235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *decpt = 9999; 36245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IEEE_Arith 36255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!word1(&u) && !(word0(&u) & 0xfffff)) 36265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return nrv_alloc("Infinity", rve, 8); 36275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return nrv_alloc("NaN", rve, 3); 36295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 36305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 36325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) += 0; /* normalize */ 36335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!dval(&u)) { 36355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *decpt = 1; 36365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return nrv_alloc("0", rve, 1); 36375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 36385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 36395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 36405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) try_quick = oldinexact = get_inexact(); 36415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) inexact = 1; 36425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 36445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (Rounding >= 2) { 36455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (*sign) 36465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Rounding = Rounding == 2 ? 0 : 2; 36475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 36485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (Rounding != 2) 36495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Rounding = 0; 36505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 36515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 36535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = d2b(&u, &be, &bbits); 36545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Sudden_Underflow 36555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = (int)(word0(&u) >> Exp_shift1 & (Exp_mask>>Exp_shift1)); 36565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 36575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((i = (int)(word0(&u) >> Exp_shift1 & (Exp_mask>>Exp_shift1)))) { 36585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&d2) = dval(&u); 36605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&d2) &= Frac_mask1; 36615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&d2) |= Exp_11; 36625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 36635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j = 11 - hi0bits(word0(&d2) & Frac_mask)) 36645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&d2) /= 1 << j; 36655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 36675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* log(x) ~=~ log(1.5) + (x-1.5)/1.5 36685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * log10(x) = log(x) / log(10) 36695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10)) 36705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2) 36715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 36725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * This suggests computing an approximation k to log10(d) by 36735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 36745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * k = (i - Bias)*0.301029995663981 36755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 ); 36765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 36775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * We want k to be too large rather than too small. 36785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * The error in the first-order Taylor series approximation 36795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * is in our favor, so we just round up the constant enough 36805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * to compensate for any error in the multiplication of 36815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077, 36825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14, 36835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * adding 1e-13 to the constant term more than suffices. 36845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Hence we adjust the constant term to 0.1760912590558. 36855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * (We could get a more accurate k by invoking log10, 36865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * but this is probably not worthwhile.) 36875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 36885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 36895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i -= Bias; 36905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 36915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i <<= 2; 36925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i += j; 36935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 36945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 36955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) denorm = 0; 36965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 36975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 36985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* d is denormalized */ 36995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 37005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = bbits + be + (Bias + (P-1) - 1); 37015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) x = i > 32 ? word0(&u) << (64 - i) | word1(&u) >> (i - 32) 37025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) : word1(&u) << (32 - i); 37035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&d2) = x; 37045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&d2) -= 31*Exp_msk1; /* adjust exponent */ 37055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i -= (Bias + (P-1) - 1) + 1; 37065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) denorm = 1; 37075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 37085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 37095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ds = (dval(&d2)-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995663981; 37105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = (int)ds; 37115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (ds < 0. && ds != k) 37125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k--; /* want k = floor(ds) */ 37135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k_check = 1; 37145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k >= 0 && k <= Ten_pmax) { 37155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dval(&u) < tens[k]) 37165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k--; 37175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k_check = 0; 37185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 37195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = bbits - i - 1; 37205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j >= 0) { 37215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b2 = 0; 37225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s2 = j; 37235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 37245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 37255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b2 = -j; 37265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s2 = 0; 37275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 37285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k >= 0) { 37295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b5 = 0; 37305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s5 = k; 37315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s2 += k; 37325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 37335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 37345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b2 -= k; 37355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b5 = -k; 37365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s5 = 0; 37375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 37385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (mode < 0 || mode > 9) 37395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mode = 0; 37405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 37415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef SET_INEXACT 37425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Check_FLT_ROUNDS 37435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) try_quick = Rounding == 1; 37445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 37455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) try_quick = 1; 37465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 37475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*SET_INEXACT*/ 37485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 37495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (mode > 5) { 37505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mode -= 4; 37515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) try_quick = 0; 37525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 37535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) leftright = 1; 37545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ilim = ilim1 = -1; /* Values for cases 0 and 1; done here to */ 37555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* silence erroneous "gcc -Wall" warning. */ 37565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(mode) { 37575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 0: 37585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 1: 37595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 18; 37605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ndigits = 0; 37615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 37625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 2: 37635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) leftright = 0; 37645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* no break */ 37655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 4: 37665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (ndigits <= 0) 37675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ndigits = 1; 37685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ilim = ilim1 = i = ndigits; 37695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 37705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 3: 37715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) leftright = 0; 37725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* no break */ 37735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 5: 37745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = ndigits + k + 1; 37755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ilim = i; 37765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ilim1 = i - 1; 37775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i <= 0) 37785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 1; 37795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 37805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s = s0 = rv_alloc(i); 37815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 37825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 37835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (mode > 1 && Rounding != 1) 37845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) leftright = 0; 37855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 37865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 37875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (ilim >= 0 && ilim <= Quick_max && try_quick) { 37885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 37895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Try to get by with floating-point arithmetic. */ 37905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 37915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 0; 37925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&d2) = dval(&u); 37935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k0 = k; 37945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ilim0 = ilim; 37955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ieps = 2; /* conservative */ 37965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k > 0) { 37975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ds = tens[k&0xf]; 37985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = k >> 4; 37995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j & Bletch) { 38005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* prevent overflows */ 38015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j &= Bletch - 1; 38025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) /= bigtens[n_bigtens-1]; 38035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ieps++; 38045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(; j; j >>= 1, i++) 38065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j & 1) { 38075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ieps++; 38085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ds *= bigtens[i]; 38095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) /= ds; 38115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if ((j1 = -k)) { 38135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) *= tens[j1 & 0xf]; 38145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(j = j1 >> 4; j; j >>= 1, i++) 38155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j & 1) { 38165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ieps++; 38175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) *= bigtens[i]; 38185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k_check && dval(&u) < 1. && ilim > 0) { 38215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (ilim1 <= 0) 38225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto fast_failed; 38235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ilim = ilim1; 38245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k--; 38255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) *= 10.; 38265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ieps++; 38275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&eps) = ieps*dval(&u) + 7.; 38295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&eps) -= (P-1)*Exp_msk1; 38305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (ilim == 0) { 38315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) S = mhi = 0; 38325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) -= 5.; 38335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dval(&u) > dval(&eps)) 38345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto one_digit; 38355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dval(&u) < -dval(&eps)) 38365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto no_digits; 38375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto fast_failed; 38385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef No_leftright 38405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (leftright) { 38415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Use Steele & White method of only 38425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * generating digits needed. 38435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 38445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&eps) = 0.5/tens[ilim-1] - dval(&eps); 38455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 0;;) { 38465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = dval(&u); 38475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) -= L; 38485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = '0' + (int)L; 38495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dval(&u) < dval(&eps)) 38505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret1; 38515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (1. - dval(&u) < dval(&eps)) 38525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto bump_up; 38535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (++i >= ilim) 38545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 38555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&eps) *= 10.; 38565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) *= 10.; 38575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 38605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 38615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Generate ilim digits, then fix them up. */ 38625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&eps) *= tens[ilim-1]; 38635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 1;; i++, dval(&u) *= 10.) { 38645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = (Long)(dval(&u)); 38655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!(dval(&u) -= L)) 38665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ilim = i; 38675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = '0' + (int)L; 38685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i == ilim) { 38695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dval(&u) > 0.5 + dval(&eps)) 38705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto bump_up; 38715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (dval(&u) < 0.5 - dval(&eps)) { 38725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(*--s == '0') {} 38735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s++; 38745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret1; 38755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 38775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef No_leftright 38805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 38825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) fast_failed: 38835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s = s0; 38845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) = dval(&d2); 38855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = k0; 38865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ilim = ilim0; 38875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 38885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 38895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Do we have a "small" integer? */ 38905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 38915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (be >= 0 && k <= Int_max) { 38925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Yes. */ 38935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ds = tens[k]; 38945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (ndigits < 0 && ilim <= 0) { 38955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) S = mhi = 0; 38965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (ilim < 0 || dval(&u) <= 5*ds) 38975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto no_digits; 38985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto one_digit; 38995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 1; i <= k + 1; i++, dval(&u) *= 10.) { 39015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L = (Long)(dval(&u) / ds); 39025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) -= L*ds; 39035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Check_FLT_ROUNDS 39045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* If FLT_ROUNDS == 2, L will usually be high by 1 */ 39055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dval(&u) < 0) { 39065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) L--; 39075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) += ds; 39085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 39105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = '0' + (int)L; 39115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!dval(&u)) { 39125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 39135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) inexact = 0; 39145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 39155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 39165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i == ilim) { 39185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 39195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (mode > 1) 39205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(Rounding) { 39215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 0: goto ret1; 39225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 2: goto bump_up; 39235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 39255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) += dval(&u); 39265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dval(&u) > ds || (dval(&u) == ds && L & 1)) { 39275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) bump_up: 39285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(*--s == '9') 39295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s == s0) { 39305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k++; 39315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s = '0'; 39325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 39335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ++*s++; 39355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 39375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret1; 39405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 39425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) m2 = b2; 39435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) m5 = b5; 39445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mhi = mlo = 0; 39455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (leftright) { 39465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 39475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 39485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) denorm ? be + (Bias + (P-1) - 1 + 1) : 39495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 39505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef IBM 39515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1 + 4*P - 3 - bbits + ((bbits + be - 1) & 3); 39525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 39535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1 + P - bbits; 39545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 39555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b2 += i; 39565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s2 += i; 39575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mhi = i2b(1); 39585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (m2 > 0 && s2 > 0) { 39605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = m2 < s2 ? m2 : s2; 39615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b2 -= i; 39625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) m2 -= i; 39635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s2 -= i; 39645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (b5 > 0) { 39665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (leftright) { 39675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (m5 > 0) { 39685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mhi = pow5mult(mhi, m5); 39695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b1 = mult(mhi, b); 39705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 39715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = b1; 39725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((j = b5 - m5)) 39745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = pow5mult(b, j); 39755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 39775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = pow5mult(b, b5); 39785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 39795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) S = i2b(1); 39805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s5 > 0) 39815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) S = pow5mult(S, s5); 39825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 39835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Check for special case that d is a normalized power of 2. */ 39845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 39855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) spec_case = 0; 39865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((mode < 2 || leftright) 39875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 39885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && Rounding == 1 39895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 39905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ) { 39915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!word1(&u) && !(word0(&u) & Bndry_mask) 39925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef Sudden_Underflow 39935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && word0(&u) & (Exp_mask & ~Exp_msk1) 39945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 39955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ) { 39965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* The special case */ 39975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b2 += Log2P; 39985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s2 += Log2P; 39995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) spec_case = 1; 40005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 40015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 40025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 40035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Arrange for convenient computation of quotients: 40045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * shift left if necessary so divisor has 4 leading 0 bits. 40055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * 40065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * Perhaps we should just compute leading 28 bits of S once 40075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * and for all and pass them and a shift to quorem, so it 40085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * can do shifts and ors to compute the numerator for q. 40095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 40105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Pack_32 40115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f)) 40125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 32 - i; 40135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define iInc 28 40145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#else 40155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0xf) 40165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = 16 - i; 40175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#define iInc 12 40185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 40195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) i = dshift(S, s2); 40205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b2 += i; 40215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) m2 += i; 40225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s2 += i; 40235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (b2 > 0) 40245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = lshift(b, b2); 40255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s2 > 0) 40265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) S = lshift(S, s2); 40275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (k_check) { 40285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (cmp(b,S) < 0) { 40295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k--; 40305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = multadd(b, 10, 0); /* we botched the k estimate */ 40315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (leftright) 40325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mhi = multadd(mhi, 10, 0); 40335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ilim = ilim1; 40345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 40355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 40365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (ilim <= 0 && (mode == 3 || mode == 5)) { 40375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (ilim < 0 || cmp(b,S = multadd(S,5,0)) <= 0) { 40385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* no digits, fcvt style */ 40395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) no_digits: 40405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k = -1 - ndigits; 40415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 40425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 40435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) one_digit: 40445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = '1'; 40455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k++; 40465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 40475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 40485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (leftright) { 40495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (m2 > 0) 40505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mhi = lshift(mhi, m2); 40515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 40525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Compute mlo -- check for special case 40535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * that d is a normalized power of 2. 40545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 40555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 40565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mlo = mhi; 40575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (spec_case) { 40585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mhi = Balloc(mhi->k); 40595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bcopy(mhi, mlo); 40605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mhi = lshift(mhi, Log2P); 40615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 40625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 40635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 1;;i++) { 40645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dig = quorem(b,S) + '0'; 40655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Do we yet have the shortest decimal string 40665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) * that will round to d? 40675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) */ 40685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = cmp(b, mlo); 40695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) delta = diff(S, mhi); 40705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j1 = delta->sign ? 1 : cmp(b, delta); 40715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(delta); 40725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef ROUND_BIASED 40735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j1 == 0 && mode != 1 && !(word1(&u) & 1) 40745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 40755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && Rounding >= 1 40765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 40775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ) { 40785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dig == '9') 40795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto round_9_up; 40805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j > 0) 40815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dig++; 40825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 40835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (!b->x[0] && b->wds <= 1) 40845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) inexact = 0; 40855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 40865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = dig; 40875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 40885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 40895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 40905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j < 0 || (j == 0 && mode != 1 40915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifndef ROUND_BIASED 40925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && !(word1(&u) & 1) 40935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 40945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) )) { 40955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!b->x[0] && b->wds <= 1) { 40965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 40975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) inexact = 0; 40985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 40995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto accept_dig; 41005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 41025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (mode > 1) 41035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(Rounding) { 41045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 0: goto accept_dig; 41055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 2: goto keep_dig; 41065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif /*Honor_FLT_ROUNDS*/ 41085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j1 > 0) { 41095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = lshift(b, 1); 41105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j1 = cmp(b, S); 41115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if ((j1 > 0 || (j1 == 0 && dig & 1)) 41125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) && dig++ == '9') 41135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto round_9_up; 41145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) accept_dig: 41165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = dig; 41175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 41185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j1 > 0) { 41205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 41215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!Rounding) 41225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto accept_dig; 41235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 41245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (dig == '9') { /* possible if i == 1 */ 41255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) round_9_up: 41265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = '9'; 41275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto roundoff; 41285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = dig + 1; 41305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 41315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 41335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) keep_dig: 41345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 41355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = dig; 41365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i == ilim) 41375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 41385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = multadd(b, 10, 0); 41395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (mlo == mhi) 41405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mlo = mhi = multadd(mhi, 10, 0); 41415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 41425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mlo = multadd(mlo, 10, 0); 41435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) mhi = multadd(mhi, 10, 0); 41445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else 41485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for(i = 1;; i++) { 41495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = dig = quorem(b,S) + '0'; 41505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!b->x[0] && b->wds <= 1) { 41515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 41525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) inexact = 0; 41535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 41545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 41555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (i >= ilim) 41575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) break; 41585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = multadd(b, 10, 0); 41595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 41615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) /* Round off last digit */ 41625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 41635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 41645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) switch(Rounding) { 41655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 0: goto trimzeros; 41665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) case 2: goto roundoff; 41675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 41695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) b = lshift(b, 1); 41705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) j = cmp(b, S); 41715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (j > 0 || (j == 0 && dig & 1)) { 41725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) roundoff: 41735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(*--s == '9') 41745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (s == s0) { 41755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) k++; 41765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s++ = '1'; 41775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) goto ret; 41785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ++*s++; 41805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else { 41825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef Honor_FLT_ROUNDS 41835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) trimzeros: 41845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 41855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while(*--s == '0') {} 41865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) s++; 41875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ret: 41895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(S); 41905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (mhi) { 41915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (mlo && mlo != mhi) 41925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(mlo); 41935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(mhi); 41945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 41955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) ret1: 41965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#ifdef SET_INEXACT 41975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (inexact) { 41985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (!oldinexact) { 41995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word0(&u) = Exp_1 + (70 << Exp_shift); 42005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) word1(&u) = 0; 42015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) dval(&u) += 1.; 42025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 42035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 42045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) else if (!oldinexact) 42055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) clear_inexact(); 42065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#endif 42075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) Bfree(b); 42085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *s = 0; 42095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *decpt = k + 1; 42105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if (rve) 42115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) *rve = s; 42125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return s0; 42135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 42145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 42155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} // namespace dmg_fp 4216