137da2899SCharles.Forsyth /* derived from /netlib/fp/dtoa.c assuming IEEE, Standard C */
237da2899SCharles.Forsyth /* kudos to dmg@bell-labs.com, gripes to ehg@bell-labs.com */
337da2899SCharles.Forsyth #include "lib9.h"
4*a4b7039aSCharles Forsyth
5*a4b7039aSCharles Forsyth #ifdef __APPLE__
6*a4b7039aSCharles Forsyth #pragma clang diagnostic ignored "-Wlogical-op-parentheses"
7*a4b7039aSCharles Forsyth #pragma clang diagnostic ignored "-Wparentheses"
8*a4b7039aSCharles Forsyth #endif
937da2899SCharles.Forsyth #define ACQUIRE_DTOA_LOCK(n) /*nothing*/
1037da2899SCharles.Forsyth #define FREE_DTOA_LOCK(n) /*nothing*/
1137da2899SCharles.Forsyth
1237da2899SCharles.Forsyth /* let's provide reasonable defaults for usual implementation of IEEE f.p. */
1337da2899SCharles.Forsyth #ifndef DBL_DIG
1437da2899SCharles.Forsyth #define DBL_DIG 15
1537da2899SCharles.Forsyth #endif
1637da2899SCharles.Forsyth #ifndef DBL_MAX_10_EXP
1737da2899SCharles.Forsyth #define DBL_MAX_10_EXP 308
1837da2899SCharles.Forsyth #endif
1937da2899SCharles.Forsyth #ifndef DBL_MAX_EXP
2037da2899SCharles.Forsyth #define DBL_MAX_EXP 1024
2137da2899SCharles.Forsyth #endif
2237da2899SCharles.Forsyth #ifndef FLT_RADIX
2337da2899SCharles.Forsyth #define FLT_RADIX 2
2437da2899SCharles.Forsyth #endif
2537da2899SCharles.Forsyth #ifndef FLT_ROUNDS
2637da2899SCharles.Forsyth #define FLT_ROUNDS 1
2737da2899SCharles.Forsyth #endif
2837da2899SCharles.Forsyth #ifndef Storeinc
2937da2899SCharles.Forsyth #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff)
3037da2899SCharles.Forsyth #endif
3137da2899SCharles.Forsyth
3237da2899SCharles.Forsyth #define Sign_Extend(a,b) if (b < 0) a |= 0xffff0000;
3337da2899SCharles.Forsyth
3468c71d4cSforsyth #ifdef USE_FPdbleword
3552bcd6aeSforsyth #define word0(x) ((FPdbleword*)&x)->hi
3652bcd6aeSforsyth #define word1(x) ((FPdbleword*)&x)->lo
3768c71d4cSforsyth #else
3837da2899SCharles.Forsyth #ifdef __LITTLE_ENDIAN
3952bcd6aeSforsyth #define word0(x) ((unsigned long *)&x)[1]
4052bcd6aeSforsyth #define word1(x) ((unsigned long *)&x)[0]
4137da2899SCharles.Forsyth #else
4237da2899SCharles.Forsyth #define word0(x) ((unsigned long *)&x)[0]
4337da2899SCharles.Forsyth #define word1(x) ((unsigned long *)&x)[1]
4437da2899SCharles.Forsyth #endif
4568c71d4cSforsyth #endif
4637da2899SCharles.Forsyth
4737da2899SCharles.Forsyth /* #define P DBL_MANT_DIG */
4837da2899SCharles.Forsyth /* Ten_pmax = floor(P*log(2)/log(5)) */
4937da2899SCharles.Forsyth /* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */
5037da2899SCharles.Forsyth /* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
5137da2899SCharles.Forsyth /* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */
5237da2899SCharles.Forsyth
5337da2899SCharles.Forsyth #define Exp_shift 20
5437da2899SCharles.Forsyth #define Exp_shift1 20
5537da2899SCharles.Forsyth #define Exp_msk1 0x100000
5637da2899SCharles.Forsyth #define Exp_msk11 0x100000
5737da2899SCharles.Forsyth #define Exp_mask 0x7ff00000
5837da2899SCharles.Forsyth #define P 53
5937da2899SCharles.Forsyth #define Bias 1023
6037da2899SCharles.Forsyth #define Emin (-1022)
6137da2899SCharles.Forsyth #define Exp_1 0x3ff00000
6237da2899SCharles.Forsyth #define Exp_11 0x3ff00000
6337da2899SCharles.Forsyth #define Ebits 11
6437da2899SCharles.Forsyth #define Frac_mask 0xfffff
6537da2899SCharles.Forsyth #define Frac_mask1 0xfffff
6637da2899SCharles.Forsyth #define Ten_pmax 22
6737da2899SCharles.Forsyth #define Bletch 0x10
6837da2899SCharles.Forsyth #define Bndry_mask 0xfffff
6937da2899SCharles.Forsyth #define Bndry_mask1 0xfffff
7037da2899SCharles.Forsyth #define LSB 1
7137da2899SCharles.Forsyth #define Sign_bit 0x80000000
7237da2899SCharles.Forsyth #define Log2P 1
7337da2899SCharles.Forsyth #define Tiny0 0
7437da2899SCharles.Forsyth #define Tiny1 1
7537da2899SCharles.Forsyth #define Quick_max 14
7637da2899SCharles.Forsyth #define Int_max 14
7737da2899SCharles.Forsyth #define Infinite(x) (word0(x) == 0x7ff00000) /* sufficient test for here */
7837da2899SCharles.Forsyth #define Avoid_Underflow
7937da2899SCharles.Forsyth
8037da2899SCharles.Forsyth #define rounded_product(a,b) a *= b
8137da2899SCharles.Forsyth #define rounded_quotient(a,b) a /= b
8237da2899SCharles.Forsyth
8337da2899SCharles.Forsyth #define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
8437da2899SCharles.Forsyth #define Big1 0xffffffff
8537da2899SCharles.Forsyth
8637da2899SCharles.Forsyth #define Kmax 15
8737da2899SCharles.Forsyth
8837da2899SCharles.Forsyth struct
8937da2899SCharles.Forsyth Bigint {
9037da2899SCharles.Forsyth struct Bigint *next;
9137da2899SCharles.Forsyth int k, maxwds, sign, wds;
9237da2899SCharles.Forsyth unsigned long x[1];
9337da2899SCharles.Forsyth };
9437da2899SCharles.Forsyth
9537da2899SCharles.Forsyth typedef struct Bigint Bigint;
9637da2899SCharles.Forsyth
9737da2899SCharles.Forsyth static Bigint *freelist[Kmax+1];
9837da2899SCharles.Forsyth
9937da2899SCharles.Forsyth static Bigint *
Balloc(int k)10037da2899SCharles.Forsyth Balloc(int k)
10137da2899SCharles.Forsyth {
10237da2899SCharles.Forsyth int x;
10337da2899SCharles.Forsyth Bigint * rv;
10437da2899SCharles.Forsyth
10537da2899SCharles.Forsyth ACQUIRE_DTOA_LOCK(0);
10637da2899SCharles.Forsyth if (rv = freelist[k]) {
10737da2899SCharles.Forsyth freelist[k] = rv->next;
10837da2899SCharles.Forsyth } else {
10937da2899SCharles.Forsyth x = 1 << k;
11037da2899SCharles.Forsyth rv = (Bigint * )malloc(sizeof(Bigint) + (x - 1) * sizeof(unsigned long));
11137da2899SCharles.Forsyth if(rv == nil)
11237da2899SCharles.Forsyth return nil;
11337da2899SCharles.Forsyth rv->k = k;
11437da2899SCharles.Forsyth rv->maxwds = x;
11537da2899SCharles.Forsyth }
11637da2899SCharles.Forsyth FREE_DTOA_LOCK(0);
11737da2899SCharles.Forsyth rv->sign = rv->wds = 0;
11837da2899SCharles.Forsyth return rv;
11937da2899SCharles.Forsyth }
12037da2899SCharles.Forsyth
12137da2899SCharles.Forsyth static void
Bfree(Bigint * v)12237da2899SCharles.Forsyth Bfree(Bigint *v)
12337da2899SCharles.Forsyth {
12437da2899SCharles.Forsyth if (v) {
12537da2899SCharles.Forsyth ACQUIRE_DTOA_LOCK(0);
12637da2899SCharles.Forsyth v->next = freelist[v->k];
12737da2899SCharles.Forsyth freelist[v->k] = v;
12837da2899SCharles.Forsyth FREE_DTOA_LOCK(0);
12937da2899SCharles.Forsyth }
13037da2899SCharles.Forsyth }
13137da2899SCharles.Forsyth
13237da2899SCharles.Forsyth #define Bcopy(x,y) memcpy((char *)&x->sign, (char *)&y->sign, \
13337da2899SCharles.Forsyth y->wds*sizeof(long) + 2*sizeof(int))
13437da2899SCharles.Forsyth
13537da2899SCharles.Forsyth static Bigint *
multadd(Bigint * b,int m,int a)13637da2899SCharles.Forsyth multadd(Bigint *b, int m, int a) /* multiply by m and add a */
13737da2899SCharles.Forsyth {
13837da2899SCharles.Forsyth int i, wds;
13937da2899SCharles.Forsyth unsigned long * x, y;
14037da2899SCharles.Forsyth unsigned long xi, z;
14137da2899SCharles.Forsyth Bigint * b1;
14237da2899SCharles.Forsyth
14337da2899SCharles.Forsyth wds = b->wds;
14437da2899SCharles.Forsyth x = b->x;
14537da2899SCharles.Forsyth i = 0;
14637da2899SCharles.Forsyth do {
14737da2899SCharles.Forsyth xi = *x;
14837da2899SCharles.Forsyth y = (xi & 0xffff) * m + a;
14937da2899SCharles.Forsyth z = (xi >> 16) * m + (y >> 16);
15037da2899SCharles.Forsyth a = (int)(z >> 16);
15137da2899SCharles.Forsyth *x++ = (z << 16) + (y & 0xffff);
15237da2899SCharles.Forsyth } while (++i < wds);
15337da2899SCharles.Forsyth if (a) {
15437da2899SCharles.Forsyth if (wds >= b->maxwds) {
15537da2899SCharles.Forsyth b1 = Balloc(b->k + 1);
15637da2899SCharles.Forsyth Bcopy(b1, b);
15737da2899SCharles.Forsyth Bfree(b);
15837da2899SCharles.Forsyth b = b1;
15937da2899SCharles.Forsyth }
16037da2899SCharles.Forsyth b->x[wds++] = a;
16137da2899SCharles.Forsyth b->wds = wds;
16237da2899SCharles.Forsyth }
16337da2899SCharles.Forsyth return b;
16437da2899SCharles.Forsyth }
16537da2899SCharles.Forsyth
16637da2899SCharles.Forsyth static Bigint *
s2b(const char * s,int nd0,int nd,unsigned long y9)16737da2899SCharles.Forsyth s2b(const char *s, int nd0, int nd, unsigned long y9)
16837da2899SCharles.Forsyth {
16937da2899SCharles.Forsyth Bigint * b;
17037da2899SCharles.Forsyth int i, k;
17137da2899SCharles.Forsyth long x, y;
17237da2899SCharles.Forsyth
17337da2899SCharles.Forsyth x = (nd + 8) / 9;
17437da2899SCharles.Forsyth for (k = 0, y = 1; x > y; y <<= 1, k++)
17537da2899SCharles.Forsyth ;
17637da2899SCharles.Forsyth b = Balloc(k);
17737da2899SCharles.Forsyth b->x[0] = y9;
17837da2899SCharles.Forsyth b->wds = 1;
17937da2899SCharles.Forsyth
18037da2899SCharles.Forsyth i = 9;
18137da2899SCharles.Forsyth if (9 < nd0) {
18237da2899SCharles.Forsyth s += 9;
18337da2899SCharles.Forsyth do
18437da2899SCharles.Forsyth b = multadd(b, 10, *s++ - '0');
18537da2899SCharles.Forsyth while (++i < nd0);
18637da2899SCharles.Forsyth s++;
18737da2899SCharles.Forsyth } else
18837da2899SCharles.Forsyth s += 10;
18937da2899SCharles.Forsyth for (; i < nd; i++)
19037da2899SCharles.Forsyth b = multadd(b, 10, *s++ - '0');
19137da2899SCharles.Forsyth return b;
19237da2899SCharles.Forsyth }
19337da2899SCharles.Forsyth
19437da2899SCharles.Forsyth static int
hi0bits(register unsigned long x)19537da2899SCharles.Forsyth hi0bits(register unsigned long x)
19637da2899SCharles.Forsyth {
19737da2899SCharles.Forsyth register int k = 0;
19837da2899SCharles.Forsyth
19937da2899SCharles.Forsyth if (!(x & 0xffff0000)) {
20037da2899SCharles.Forsyth k = 16;
20137da2899SCharles.Forsyth x <<= 16;
20237da2899SCharles.Forsyth }
20337da2899SCharles.Forsyth if (!(x & 0xff000000)) {
20437da2899SCharles.Forsyth k += 8;
20537da2899SCharles.Forsyth x <<= 8;
20637da2899SCharles.Forsyth }
20737da2899SCharles.Forsyth if (!(x & 0xf0000000)) {
20837da2899SCharles.Forsyth k += 4;
20937da2899SCharles.Forsyth x <<= 4;
21037da2899SCharles.Forsyth }
21137da2899SCharles.Forsyth if (!(x & 0xc0000000)) {
21237da2899SCharles.Forsyth k += 2;
21337da2899SCharles.Forsyth x <<= 2;
21437da2899SCharles.Forsyth }
21537da2899SCharles.Forsyth if (!(x & 0x80000000)) {
21637da2899SCharles.Forsyth k++;
21737da2899SCharles.Forsyth if (!(x & 0x40000000))
21837da2899SCharles.Forsyth return 32;
21937da2899SCharles.Forsyth }
22037da2899SCharles.Forsyth return k;
22137da2899SCharles.Forsyth }
22237da2899SCharles.Forsyth
22337da2899SCharles.Forsyth static int
lo0bits(unsigned long * y)22437da2899SCharles.Forsyth lo0bits(unsigned long *y)
22537da2899SCharles.Forsyth {
22637da2899SCharles.Forsyth register int k;
22737da2899SCharles.Forsyth register unsigned long x = *y;
22837da2899SCharles.Forsyth
22937da2899SCharles.Forsyth if (x & 7) {
23037da2899SCharles.Forsyth if (x & 1)
23137da2899SCharles.Forsyth return 0;
23237da2899SCharles.Forsyth if (x & 2) {
23337da2899SCharles.Forsyth *y = x >> 1;
23437da2899SCharles.Forsyth return 1;
23537da2899SCharles.Forsyth }
23637da2899SCharles.Forsyth *y = x >> 2;
23737da2899SCharles.Forsyth return 2;
23837da2899SCharles.Forsyth }
23937da2899SCharles.Forsyth k = 0;
24037da2899SCharles.Forsyth if (!(x & 0xffff)) {
24137da2899SCharles.Forsyth k = 16;
24237da2899SCharles.Forsyth x >>= 16;
24337da2899SCharles.Forsyth }
24437da2899SCharles.Forsyth if (!(x & 0xff)) {
24537da2899SCharles.Forsyth k += 8;
24637da2899SCharles.Forsyth x >>= 8;
24737da2899SCharles.Forsyth }
24837da2899SCharles.Forsyth if (!(x & 0xf)) {
24937da2899SCharles.Forsyth k += 4;
25037da2899SCharles.Forsyth x >>= 4;
25137da2899SCharles.Forsyth }
25237da2899SCharles.Forsyth if (!(x & 0x3)) {
25337da2899SCharles.Forsyth k += 2;
25437da2899SCharles.Forsyth x >>= 2;
25537da2899SCharles.Forsyth }
25637da2899SCharles.Forsyth if (!(x & 1)) {
25737da2899SCharles.Forsyth k++;
25837da2899SCharles.Forsyth x >>= 1;
25937da2899SCharles.Forsyth if (!x & 1)
26037da2899SCharles.Forsyth return 32;
26137da2899SCharles.Forsyth }
26237da2899SCharles.Forsyth *y = x;
26337da2899SCharles.Forsyth return k;
26437da2899SCharles.Forsyth }
26537da2899SCharles.Forsyth
26637da2899SCharles.Forsyth static Bigint *
i2b(int i)26737da2899SCharles.Forsyth i2b(int i)
26837da2899SCharles.Forsyth {
26937da2899SCharles.Forsyth Bigint * b;
27037da2899SCharles.Forsyth
27137da2899SCharles.Forsyth b = Balloc(1);
27237da2899SCharles.Forsyth b->x[0] = i;
27337da2899SCharles.Forsyth b->wds = 1;
27437da2899SCharles.Forsyth return b;
27537da2899SCharles.Forsyth }
27637da2899SCharles.Forsyth
27737da2899SCharles.Forsyth static Bigint *
mult(Bigint * a,Bigint * b)27837da2899SCharles.Forsyth mult(Bigint *a, Bigint *b)
27937da2899SCharles.Forsyth {
28037da2899SCharles.Forsyth Bigint * c;
28137da2899SCharles.Forsyth int k, wa, wb, wc;
28237da2899SCharles.Forsyth unsigned long carry, y, z;
28337da2899SCharles.Forsyth unsigned long * x, *xa, *xae, *xb, *xbe, *xc, *xc0;
28437da2899SCharles.Forsyth unsigned long z2;
28537da2899SCharles.Forsyth
28637da2899SCharles.Forsyth if (a->wds < b->wds) {
28737da2899SCharles.Forsyth c = a;
28837da2899SCharles.Forsyth a = b;
28937da2899SCharles.Forsyth b = c;
29037da2899SCharles.Forsyth }
29137da2899SCharles.Forsyth k = a->k;
29237da2899SCharles.Forsyth wa = a->wds;
29337da2899SCharles.Forsyth wb = b->wds;
29437da2899SCharles.Forsyth wc = wa + wb;
29537da2899SCharles.Forsyth if (wc > a->maxwds)
29637da2899SCharles.Forsyth k++;
29737da2899SCharles.Forsyth c = Balloc(k);
29837da2899SCharles.Forsyth for (x = c->x, xa = x + wc; x < xa; x++)
29937da2899SCharles.Forsyth *x = 0;
30037da2899SCharles.Forsyth xa = a->x;
30137da2899SCharles.Forsyth xae = xa + wa;
30237da2899SCharles.Forsyth xb = b->x;
30337da2899SCharles.Forsyth xbe = xb + wb;
30437da2899SCharles.Forsyth xc0 = c->x;
30537da2899SCharles.Forsyth for (; xb < xbe; xb++, xc0++) {
30637da2899SCharles.Forsyth if (y = *xb & 0xffff) {
30737da2899SCharles.Forsyth x = xa;
30837da2899SCharles.Forsyth xc = xc0;
30937da2899SCharles.Forsyth carry = 0;
31037da2899SCharles.Forsyth do {
31137da2899SCharles.Forsyth z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
31237da2899SCharles.Forsyth carry = z >> 16;
31337da2899SCharles.Forsyth z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
31437da2899SCharles.Forsyth carry = z2 >> 16;
31537da2899SCharles.Forsyth Storeinc(xc, z2, z);
31637da2899SCharles.Forsyth } while (x < xae);
31737da2899SCharles.Forsyth *xc = carry;
31837da2899SCharles.Forsyth }
31937da2899SCharles.Forsyth if (y = *xb >> 16) {
32037da2899SCharles.Forsyth x = xa;
32137da2899SCharles.Forsyth xc = xc0;
32237da2899SCharles.Forsyth carry = 0;
32337da2899SCharles.Forsyth z2 = *xc;
32437da2899SCharles.Forsyth do {
32537da2899SCharles.Forsyth z = (*x & 0xffff) * y + (*xc >> 16) + carry;
32637da2899SCharles.Forsyth carry = z >> 16;
32737da2899SCharles.Forsyth Storeinc(xc, z, z2);
32837da2899SCharles.Forsyth z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
32937da2899SCharles.Forsyth carry = z2 >> 16;
33037da2899SCharles.Forsyth } while (x < xae);
33137da2899SCharles.Forsyth *xc = z2;
33237da2899SCharles.Forsyth }
33337da2899SCharles.Forsyth }
33437da2899SCharles.Forsyth for (xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc)
33537da2899SCharles.Forsyth ;
33637da2899SCharles.Forsyth c->wds = wc;
33737da2899SCharles.Forsyth return c;
33837da2899SCharles.Forsyth }
33937da2899SCharles.Forsyth
34037da2899SCharles.Forsyth static Bigint *p5s;
34137da2899SCharles.Forsyth
34237da2899SCharles.Forsyth static Bigint *
pow5mult(Bigint * b,int k)34337da2899SCharles.Forsyth pow5mult(Bigint *b, int k)
34437da2899SCharles.Forsyth {
34537da2899SCharles.Forsyth Bigint * b1, *p5, *p51;
34637da2899SCharles.Forsyth int i;
34737da2899SCharles.Forsyth static int p05[3] = {
34837da2899SCharles.Forsyth 5, 25, 125 };
34937da2899SCharles.Forsyth
35037da2899SCharles.Forsyth if (i = k & 3)
35137da2899SCharles.Forsyth b = multadd(b, p05[i-1], 0);
35237da2899SCharles.Forsyth
35337da2899SCharles.Forsyth if (!(k >>= 2))
35437da2899SCharles.Forsyth return b;
35537da2899SCharles.Forsyth if (!(p5 = p5s)) {
35637da2899SCharles.Forsyth /* first time */
35737da2899SCharles.Forsyth ACQUIRE_DTOA_LOCK(1);
35837da2899SCharles.Forsyth if (!(p5 = p5s)) {
35937da2899SCharles.Forsyth p5 = p5s = i2b(625);
36037da2899SCharles.Forsyth p5->next = 0;
36137da2899SCharles.Forsyth }
36237da2899SCharles.Forsyth FREE_DTOA_LOCK(1);
36337da2899SCharles.Forsyth }
36437da2899SCharles.Forsyth for (; ; ) {
36537da2899SCharles.Forsyth if (k & 1) {
36637da2899SCharles.Forsyth b1 = mult(b, p5);
36737da2899SCharles.Forsyth Bfree(b);
36837da2899SCharles.Forsyth b = b1;
36937da2899SCharles.Forsyth }
37037da2899SCharles.Forsyth if (!(k >>= 1))
37137da2899SCharles.Forsyth break;
37237da2899SCharles.Forsyth if (!(p51 = p5->next)) {
37337da2899SCharles.Forsyth ACQUIRE_DTOA_LOCK(1);
37437da2899SCharles.Forsyth if (!(p51 = p5->next)) {
37537da2899SCharles.Forsyth p51 = p5->next = mult(p5, p5);
37637da2899SCharles.Forsyth p51->next = 0;
37737da2899SCharles.Forsyth }
37837da2899SCharles.Forsyth FREE_DTOA_LOCK(1);
37937da2899SCharles.Forsyth }
38037da2899SCharles.Forsyth p5 = p51;
38137da2899SCharles.Forsyth }
38237da2899SCharles.Forsyth return b;
38337da2899SCharles.Forsyth }
38437da2899SCharles.Forsyth
38537da2899SCharles.Forsyth static Bigint *
lshift(Bigint * b,int k)38637da2899SCharles.Forsyth lshift(Bigint *b, int k)
38737da2899SCharles.Forsyth {
38837da2899SCharles.Forsyth int i, k1, n, n1;
38937da2899SCharles.Forsyth Bigint * b1;
39037da2899SCharles.Forsyth unsigned long * x, *x1, *xe, z;
39137da2899SCharles.Forsyth
39237da2899SCharles.Forsyth n = k >> 5;
39337da2899SCharles.Forsyth k1 = b->k;
39437da2899SCharles.Forsyth n1 = n + b->wds + 1;
39537da2899SCharles.Forsyth for (i = b->maxwds; n1 > i; i <<= 1)
39637da2899SCharles.Forsyth k1++;
39737da2899SCharles.Forsyth b1 = Balloc(k1);
39837da2899SCharles.Forsyth x1 = b1->x;
39937da2899SCharles.Forsyth for (i = 0; i < n; i++)
40037da2899SCharles.Forsyth *x1++ = 0;
40137da2899SCharles.Forsyth x = b->x;
40237da2899SCharles.Forsyth xe = x + b->wds;
40337da2899SCharles.Forsyth if (k &= 0x1f) {
40437da2899SCharles.Forsyth k1 = 32 - k;
40537da2899SCharles.Forsyth z = 0;
40637da2899SCharles.Forsyth do {
40737da2899SCharles.Forsyth *x1++ = *x << k | z;
40837da2899SCharles.Forsyth z = *x++ >> k1;
40937da2899SCharles.Forsyth } while (x < xe);
41037da2899SCharles.Forsyth if (*x1 = z)
41137da2899SCharles.Forsyth ++n1;
41237da2899SCharles.Forsyth } else
41337da2899SCharles.Forsyth do
41437da2899SCharles.Forsyth *x1++ = *x++;
41537da2899SCharles.Forsyth while (x < xe);
41637da2899SCharles.Forsyth b1->wds = n1 - 1;
41737da2899SCharles.Forsyth Bfree(b);
41837da2899SCharles.Forsyth return b1;
41937da2899SCharles.Forsyth }
42037da2899SCharles.Forsyth
42137da2899SCharles.Forsyth static int
cmp(Bigint * a,Bigint * b)42237da2899SCharles.Forsyth cmp(Bigint *a, Bigint *b)
42337da2899SCharles.Forsyth {
42437da2899SCharles.Forsyth unsigned long * xa, *xa0, *xb, *xb0;
42537da2899SCharles.Forsyth int i, j;
42637da2899SCharles.Forsyth
42737da2899SCharles.Forsyth i = a->wds;
42837da2899SCharles.Forsyth j = b->wds;
42937da2899SCharles.Forsyth if (i -= j)
43037da2899SCharles.Forsyth return i;
43137da2899SCharles.Forsyth xa0 = a->x;
43237da2899SCharles.Forsyth xa = xa0 + j;
43337da2899SCharles.Forsyth xb0 = b->x;
43437da2899SCharles.Forsyth xb = xb0 + j;
43537da2899SCharles.Forsyth for (; ; ) {
43637da2899SCharles.Forsyth if (*--xa != *--xb)
43737da2899SCharles.Forsyth return * xa < *xb ? -1 : 1;
43837da2899SCharles.Forsyth if (xa <= xa0)
43937da2899SCharles.Forsyth break;
44037da2899SCharles.Forsyth }
44137da2899SCharles.Forsyth return 0;
44237da2899SCharles.Forsyth }
44337da2899SCharles.Forsyth
44437da2899SCharles.Forsyth static Bigint *
diff(Bigint * a,Bigint * b)44537da2899SCharles.Forsyth diff(Bigint *a, Bigint *b)
44637da2899SCharles.Forsyth {
44737da2899SCharles.Forsyth Bigint * c;
44837da2899SCharles.Forsyth int i, wa, wb;
44937da2899SCharles.Forsyth long borrow, y; /* We need signed shifts here. */
45037da2899SCharles.Forsyth unsigned long * xa, *xae, *xb, *xbe, *xc;
45137da2899SCharles.Forsyth long z;
45237da2899SCharles.Forsyth
45337da2899SCharles.Forsyth i = cmp(a, b);
45437da2899SCharles.Forsyth if (!i) {
45537da2899SCharles.Forsyth c = Balloc(0);
45637da2899SCharles.Forsyth c->wds = 1;
45737da2899SCharles.Forsyth c->x[0] = 0;
45837da2899SCharles.Forsyth return c;
45937da2899SCharles.Forsyth }
46037da2899SCharles.Forsyth if (i < 0) {
46137da2899SCharles.Forsyth c = a;
46237da2899SCharles.Forsyth a = b;
46337da2899SCharles.Forsyth b = c;
46437da2899SCharles.Forsyth i = 1;
46537da2899SCharles.Forsyth } else
46637da2899SCharles.Forsyth i = 0;
46737da2899SCharles.Forsyth c = Balloc(a->k);
46837da2899SCharles.Forsyth c->sign = i;
46937da2899SCharles.Forsyth wa = a->wds;
47037da2899SCharles.Forsyth xa = a->x;
47137da2899SCharles.Forsyth xae = xa + wa;
47237da2899SCharles.Forsyth wb = b->wds;
47337da2899SCharles.Forsyth xb = b->x;
47437da2899SCharles.Forsyth xbe = xb + wb;
47537da2899SCharles.Forsyth xc = c->x;
47637da2899SCharles.Forsyth borrow = 0;
47737da2899SCharles.Forsyth do {
47837da2899SCharles.Forsyth y = (*xa & 0xffff) - (*xb & 0xffff) + borrow;
47937da2899SCharles.Forsyth borrow = y >> 16;
48037da2899SCharles.Forsyth Sign_Extend(borrow, y);
48137da2899SCharles.Forsyth z = (*xa++ >> 16) - (*xb++ >> 16) + borrow;
48237da2899SCharles.Forsyth borrow = z >> 16;
48337da2899SCharles.Forsyth Sign_Extend(borrow, z);
48437da2899SCharles.Forsyth Storeinc(xc, z, y);
48537da2899SCharles.Forsyth } while (xb < xbe);
48637da2899SCharles.Forsyth while (xa < xae) {
48737da2899SCharles.Forsyth y = (*xa & 0xffff) + borrow;
48837da2899SCharles.Forsyth borrow = y >> 16;
48937da2899SCharles.Forsyth Sign_Extend(borrow, y);
49037da2899SCharles.Forsyth z = (*xa++ >> 16) + borrow;
49137da2899SCharles.Forsyth borrow = z >> 16;
49237da2899SCharles.Forsyth Sign_Extend(borrow, z);
49337da2899SCharles.Forsyth Storeinc(xc, z, y);
49437da2899SCharles.Forsyth }
49537da2899SCharles.Forsyth while (!*--xc)
49637da2899SCharles.Forsyth wa--;
49737da2899SCharles.Forsyth c->wds = wa;
49837da2899SCharles.Forsyth return c;
49937da2899SCharles.Forsyth }
50037da2899SCharles.Forsyth
50137da2899SCharles.Forsyth static double
ulp(double x)50237da2899SCharles.Forsyth ulp(double x)
50337da2899SCharles.Forsyth {
50437da2899SCharles.Forsyth register long L;
50537da2899SCharles.Forsyth double a;
50637da2899SCharles.Forsyth
50737da2899SCharles.Forsyth L = (word0(x) & Exp_mask) - (P - 1) * Exp_msk1;
50837da2899SCharles.Forsyth #ifndef Sudden_Underflow
50937da2899SCharles.Forsyth if (L > 0) {
51037da2899SCharles.Forsyth #endif
51137da2899SCharles.Forsyth word0(a) = L;
51237da2899SCharles.Forsyth word1(a) = 0;
51337da2899SCharles.Forsyth #ifndef Sudden_Underflow
51437da2899SCharles.Forsyth } else {
51537da2899SCharles.Forsyth L = -L >> Exp_shift;
51637da2899SCharles.Forsyth if (L < Exp_shift) {
51737da2899SCharles.Forsyth word0(a) = 0x80000 >> L;
51837da2899SCharles.Forsyth word1(a) = 0;
51937da2899SCharles.Forsyth } else {
52037da2899SCharles.Forsyth word0(a) = 0;
52137da2899SCharles.Forsyth L -= Exp_shift;
52237da2899SCharles.Forsyth word1(a) = L >= 31 ? 1 : 1 << 31 - L;
52337da2899SCharles.Forsyth }
52437da2899SCharles.Forsyth }
52537da2899SCharles.Forsyth #endif
52637da2899SCharles.Forsyth return a;
52737da2899SCharles.Forsyth }
52837da2899SCharles.Forsyth
52937da2899SCharles.Forsyth static double
b2d(Bigint * a,int * e)53037da2899SCharles.Forsyth b2d(Bigint *a, int *e)
53137da2899SCharles.Forsyth {
53237da2899SCharles.Forsyth unsigned long * xa, *xa0, w, y, z;
53337da2899SCharles.Forsyth int k;
53437da2899SCharles.Forsyth double d;
53537da2899SCharles.Forsyth #define d0 word0(d)
53637da2899SCharles.Forsyth #define d1 word1(d)
53737da2899SCharles.Forsyth
53837da2899SCharles.Forsyth xa0 = a->x;
53937da2899SCharles.Forsyth xa = xa0 + a->wds;
54037da2899SCharles.Forsyth y = *--xa;
54137da2899SCharles.Forsyth k = hi0bits(y);
54237da2899SCharles.Forsyth *e = 32 - k;
54337da2899SCharles.Forsyth if (k < Ebits) {
54437da2899SCharles.Forsyth d0 = Exp_1 | y >> Ebits - k;
54537da2899SCharles.Forsyth w = xa > xa0 ? *--xa : 0;
54637da2899SCharles.Forsyth d1 = y << (32 - Ebits) + k | w >> Ebits - k;
54737da2899SCharles.Forsyth goto ret_d;
54837da2899SCharles.Forsyth }
54937da2899SCharles.Forsyth z = xa > xa0 ? *--xa : 0;
55037da2899SCharles.Forsyth if (k -= Ebits) {
55137da2899SCharles.Forsyth d0 = Exp_1 | y << k | z >> 32 - k;
55237da2899SCharles.Forsyth y = xa > xa0 ? *--xa : 0;
55337da2899SCharles.Forsyth d1 = z << k | y >> 32 - k;
55437da2899SCharles.Forsyth } else {
55537da2899SCharles.Forsyth d0 = Exp_1 | y;
55637da2899SCharles.Forsyth d1 = z;
55737da2899SCharles.Forsyth }
55837da2899SCharles.Forsyth ret_d:
55937da2899SCharles.Forsyth #undef d0
56037da2899SCharles.Forsyth #undef d1
56137da2899SCharles.Forsyth return d;
56237da2899SCharles.Forsyth }
56337da2899SCharles.Forsyth
56437da2899SCharles.Forsyth static Bigint *
d2b(double d,int * e,int * bits)56537da2899SCharles.Forsyth d2b(double d, int *e, int *bits)
56637da2899SCharles.Forsyth {
56737da2899SCharles.Forsyth Bigint * b;
56837da2899SCharles.Forsyth int de, i, k;
56937da2899SCharles.Forsyth unsigned long * x, y, z;
57037da2899SCharles.Forsyth #define d0 word0(d)
57137da2899SCharles.Forsyth #define d1 word1(d)
57237da2899SCharles.Forsyth
57337da2899SCharles.Forsyth b = Balloc(1);
57437da2899SCharles.Forsyth x = b->x;
57537da2899SCharles.Forsyth
57637da2899SCharles.Forsyth z = d0 & Frac_mask;
57737da2899SCharles.Forsyth d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
57837da2899SCharles.Forsyth #ifdef Sudden_Underflow
57937da2899SCharles.Forsyth de = (int)(d0 >> Exp_shift);
58037da2899SCharles.Forsyth z |= Exp_msk11;
58137da2899SCharles.Forsyth #else
58237da2899SCharles.Forsyth if (de = (int)(d0 >> Exp_shift))
58337da2899SCharles.Forsyth z |= Exp_msk1;
58437da2899SCharles.Forsyth #endif
58537da2899SCharles.Forsyth if (y = d1) {
58637da2899SCharles.Forsyth if (k = lo0bits(&y)) {
58737da2899SCharles.Forsyth x[0] = y | z << 32 - k;
58837da2899SCharles.Forsyth z >>= k;
58937da2899SCharles.Forsyth } else
59037da2899SCharles.Forsyth x[0] = y;
59137da2899SCharles.Forsyth i = b->wds = (x[1] = z) ? 2 : 1;
59237da2899SCharles.Forsyth } else {
59337da2899SCharles.Forsyth k = lo0bits(&z);
59437da2899SCharles.Forsyth x[0] = z;
59537da2899SCharles.Forsyth i = b->wds = 1;
59637da2899SCharles.Forsyth k += 32;
59737da2899SCharles.Forsyth }
59837da2899SCharles.Forsyth #ifndef Sudden_Underflow
59937da2899SCharles.Forsyth if (de) {
60037da2899SCharles.Forsyth #endif
60137da2899SCharles.Forsyth *e = de - Bias - (P - 1) + k;
60237da2899SCharles.Forsyth *bits = P - k;
60337da2899SCharles.Forsyth #ifndef Sudden_Underflow
60437da2899SCharles.Forsyth } else {
60537da2899SCharles.Forsyth *e = de - Bias - (P - 1) + 1 + k;
60637da2899SCharles.Forsyth *bits = 32 * i - hi0bits(x[i-1]);
60737da2899SCharles.Forsyth }
60837da2899SCharles.Forsyth #endif
60937da2899SCharles.Forsyth return b;
61037da2899SCharles.Forsyth }
61137da2899SCharles.Forsyth
61237da2899SCharles.Forsyth #undef d0
61337da2899SCharles.Forsyth #undef d1
61437da2899SCharles.Forsyth
61537da2899SCharles.Forsyth static double
ratio(Bigint * a,Bigint * b)61637da2899SCharles.Forsyth ratio(Bigint *a, Bigint *b)
61737da2899SCharles.Forsyth {
61837da2899SCharles.Forsyth double da, db;
61937da2899SCharles.Forsyth int k, ka, kb;
62037da2899SCharles.Forsyth
62137da2899SCharles.Forsyth da = b2d(a, &ka);
62237da2899SCharles.Forsyth db = b2d(b, &kb);
62337da2899SCharles.Forsyth k = ka - kb + 32 * (a->wds - b->wds);
62437da2899SCharles.Forsyth if (k > 0)
62537da2899SCharles.Forsyth word0(da) += k * Exp_msk1;
62637da2899SCharles.Forsyth else {
62737da2899SCharles.Forsyth k = -k;
62837da2899SCharles.Forsyth word0(db) += k * Exp_msk1;
62937da2899SCharles.Forsyth }
63037da2899SCharles.Forsyth return da / db;
63137da2899SCharles.Forsyth }
63237da2899SCharles.Forsyth
63337da2899SCharles.Forsyth static const double
63437da2899SCharles.Forsyth tens[] = {
63537da2899SCharles.Forsyth 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
63637da2899SCharles.Forsyth 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
63737da2899SCharles.Forsyth 1e20, 1e21, 1e22
63837da2899SCharles.Forsyth };
63937da2899SCharles.Forsyth
64037da2899SCharles.Forsyth static const double
64137da2899SCharles.Forsyth bigtens[] = {
64237da2899SCharles.Forsyth 1e16, 1e32, 1e64, 1e128, 1e256 };
64337da2899SCharles.Forsyth
64437da2899SCharles.Forsyth static const double tinytens[] = {
64537da2899SCharles.Forsyth 1e-16, 1e-32, 1e-64, 1e-128,
64637da2899SCharles.Forsyth 9007199254740992.e-256
64737da2899SCharles.Forsyth };
64837da2899SCharles.Forsyth
64937da2899SCharles.Forsyth /* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */
65037da2899SCharles.Forsyth /* flag unnecessarily. It leads to a song and dance at the end of strtod. */
65137da2899SCharles.Forsyth #define Scale_Bit 0x10
65237da2899SCharles.Forsyth #define n_bigtens 5
65337da2899SCharles.Forsyth
65437da2899SCharles.Forsyth #define NAN_WORD0 0x7ff80000
65537da2899SCharles.Forsyth
65637da2899SCharles.Forsyth #define NAN_WORD1 0
65737da2899SCharles.Forsyth
65837da2899SCharles.Forsyth static int
match(const char ** sp,char * t)65937da2899SCharles.Forsyth match(const char **sp, char *t)
66037da2899SCharles.Forsyth {
66137da2899SCharles.Forsyth int c, d;
66237da2899SCharles.Forsyth const char * s = *sp;
66337da2899SCharles.Forsyth
66437da2899SCharles.Forsyth while (d = *t++) {
66537da2899SCharles.Forsyth if ((c = *++s) >= 'A' && c <= 'Z')
66637da2899SCharles.Forsyth c += 'a' - 'A';
66737da2899SCharles.Forsyth if (c != d)
66837da2899SCharles.Forsyth return 0;
66937da2899SCharles.Forsyth }
67037da2899SCharles.Forsyth *sp = s + 1;
67137da2899SCharles.Forsyth return 1;
67237da2899SCharles.Forsyth }
67337da2899SCharles.Forsyth
67437da2899SCharles.Forsyth double
strtod(const char * s00,char ** se)67537da2899SCharles.Forsyth strtod(const char *s00, char **se)
67637da2899SCharles.Forsyth {
67737da2899SCharles.Forsyth int scale;
67837da2899SCharles.Forsyth int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign,
67937da2899SCharles.Forsyth e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
68037da2899SCharles.Forsyth const char * s, *s0, *s1;
68137da2899SCharles.Forsyth double aadj, aadj1, adj, rv, rv0;
68237da2899SCharles.Forsyth long L;
68337da2899SCharles.Forsyth unsigned long y, z;
68437da2899SCharles.Forsyth Bigint * bb, *bb1, *bd, *bd0, *bs, *delta;
68537da2899SCharles.Forsyth sign = nz0 = nz = 0;
68637da2899SCharles.Forsyth rv = 0.;
68737da2899SCharles.Forsyth for (s = s00; ; s++)
68837da2899SCharles.Forsyth switch (*s) {
68937da2899SCharles.Forsyth case '-':
69037da2899SCharles.Forsyth sign = 1;
69137da2899SCharles.Forsyth /* no break */
69237da2899SCharles.Forsyth case '+':
69337da2899SCharles.Forsyth if (*++s)
69437da2899SCharles.Forsyth goto break2;
69537da2899SCharles.Forsyth /* no break */
69637da2899SCharles.Forsyth case 0:
69737da2899SCharles.Forsyth s = s00;
69837da2899SCharles.Forsyth goto ret;
69937da2899SCharles.Forsyth case '\t':
70037da2899SCharles.Forsyth case '\n':
70137da2899SCharles.Forsyth case '\v':
70237da2899SCharles.Forsyth case '\f':
70337da2899SCharles.Forsyth case '\r':
70437da2899SCharles.Forsyth case ' ':
70537da2899SCharles.Forsyth continue;
70637da2899SCharles.Forsyth default:
70737da2899SCharles.Forsyth goto break2;
70837da2899SCharles.Forsyth }
70937da2899SCharles.Forsyth break2:
71037da2899SCharles.Forsyth if (*s == '0') {
71137da2899SCharles.Forsyth nz0 = 1;
71237da2899SCharles.Forsyth while (*++s == '0')
71337da2899SCharles.Forsyth ;
71437da2899SCharles.Forsyth if (!*s)
71537da2899SCharles.Forsyth goto ret;
71637da2899SCharles.Forsyth }
71737da2899SCharles.Forsyth s0 = s;
71837da2899SCharles.Forsyth y = z = 0;
71937da2899SCharles.Forsyth for (nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
72037da2899SCharles.Forsyth if (nd < 9)
72137da2899SCharles.Forsyth y = 10 * y + c - '0';
72237da2899SCharles.Forsyth else if (nd < 16)
72337da2899SCharles.Forsyth z = 10 * z + c - '0';
72437da2899SCharles.Forsyth nd0 = nd;
72537da2899SCharles.Forsyth if (c == '.') {
72637da2899SCharles.Forsyth c = *++s;
72737da2899SCharles.Forsyth if (!nd) {
72837da2899SCharles.Forsyth for (; c == '0'; c = *++s)
72937da2899SCharles.Forsyth nz++;
73037da2899SCharles.Forsyth if (c > '0' && c <= '9') {
73137da2899SCharles.Forsyth s0 = s;
73237da2899SCharles.Forsyth nf += nz;
73337da2899SCharles.Forsyth nz = 0;
73437da2899SCharles.Forsyth goto have_dig;
73537da2899SCharles.Forsyth }
73637da2899SCharles.Forsyth goto dig_done;
73737da2899SCharles.Forsyth }
73837da2899SCharles.Forsyth for (; c >= '0' && c <= '9'; c = *++s) {
73937da2899SCharles.Forsyth have_dig:
74037da2899SCharles.Forsyth nz++;
74137da2899SCharles.Forsyth if (c -= '0') {
74237da2899SCharles.Forsyth nf += nz;
74337da2899SCharles.Forsyth for (i = 1; i < nz; i++)
74437da2899SCharles.Forsyth if (nd++ < 9)
74537da2899SCharles.Forsyth y *= 10;
74637da2899SCharles.Forsyth else if (nd <= DBL_DIG + 1)
74737da2899SCharles.Forsyth z *= 10;
74837da2899SCharles.Forsyth if (nd++ < 9)
74937da2899SCharles.Forsyth y = 10 * y + c;
75037da2899SCharles.Forsyth else if (nd <= DBL_DIG + 1)
75137da2899SCharles.Forsyth z = 10 * z + c;
75237da2899SCharles.Forsyth nz = 0;
75337da2899SCharles.Forsyth }
75437da2899SCharles.Forsyth }
75537da2899SCharles.Forsyth }
75637da2899SCharles.Forsyth dig_done:
75737da2899SCharles.Forsyth e = 0;
75837da2899SCharles.Forsyth if (c == 'e' || c == 'E') {
75937da2899SCharles.Forsyth if (!nd && !nz && !nz0) {
76037da2899SCharles.Forsyth s = s00;
76137da2899SCharles.Forsyth goto ret;
76237da2899SCharles.Forsyth }
76337da2899SCharles.Forsyth s00 = s;
76437da2899SCharles.Forsyth esign = 0;
76537da2899SCharles.Forsyth switch (c = *++s) {
76637da2899SCharles.Forsyth case '-':
76737da2899SCharles.Forsyth esign = 1;
76837da2899SCharles.Forsyth case '+':
76937da2899SCharles.Forsyth c = *++s;
77037da2899SCharles.Forsyth }
77137da2899SCharles.Forsyth if (c >= '0' && c <= '9') {
77237da2899SCharles.Forsyth while (c == '0')
77337da2899SCharles.Forsyth c = *++s;
77437da2899SCharles.Forsyth if (c > '0' && c <= '9') {
77537da2899SCharles.Forsyth L = c - '0';
77637da2899SCharles.Forsyth s1 = s;
77737da2899SCharles.Forsyth while ((c = *++s) >= '0' && c <= '9')
77837da2899SCharles.Forsyth L = 10 * L + c - '0';
77937da2899SCharles.Forsyth if (s - s1 > 8 || L > 19999)
78037da2899SCharles.Forsyth /* Avoid confusion from exponents
78137da2899SCharles.Forsyth * so large that e might overflow.
78237da2899SCharles.Forsyth */
78337da2899SCharles.Forsyth e = 19999; /* safe for 16 bit ints */
78437da2899SCharles.Forsyth else
78537da2899SCharles.Forsyth e = (int)L;
78637da2899SCharles.Forsyth if (esign)
78737da2899SCharles.Forsyth e = -e;
78837da2899SCharles.Forsyth } else
78937da2899SCharles.Forsyth e = 0;
79037da2899SCharles.Forsyth } else
79137da2899SCharles.Forsyth s = s00;
79237da2899SCharles.Forsyth }
79337da2899SCharles.Forsyth if (!nd) {
79437da2899SCharles.Forsyth if (!nz && !nz0) {
79537da2899SCharles.Forsyth /* Check for Nan and Infinity */
79637da2899SCharles.Forsyth switch (c) {
79737da2899SCharles.Forsyth case 'i':
79837da2899SCharles.Forsyth case 'I':
79937da2899SCharles.Forsyth if (match(&s, "nfinity")) {
80037da2899SCharles.Forsyth word0(rv) = 0x7ff00000;
80137da2899SCharles.Forsyth word1(rv) = 0;
80237da2899SCharles.Forsyth goto ret;
80337da2899SCharles.Forsyth }
80437da2899SCharles.Forsyth break;
80537da2899SCharles.Forsyth case 'n':
80637da2899SCharles.Forsyth case 'N':
80737da2899SCharles.Forsyth if (match(&s, "an")) {
80837da2899SCharles.Forsyth word0(rv) = NAN_WORD0;
80937da2899SCharles.Forsyth word1(rv) = NAN_WORD1;
81037da2899SCharles.Forsyth goto ret;
81137da2899SCharles.Forsyth }
81237da2899SCharles.Forsyth }
81337da2899SCharles.Forsyth s = s00;
81437da2899SCharles.Forsyth }
81537da2899SCharles.Forsyth goto ret;
81637da2899SCharles.Forsyth }
81737da2899SCharles.Forsyth e1 = e -= nf;
81837da2899SCharles.Forsyth
81937da2899SCharles.Forsyth /* Now we have nd0 digits, starting at s0, followed by a
82037da2899SCharles.Forsyth * decimal point, followed by nd-nd0 digits. The number we're
82137da2899SCharles.Forsyth * after is the integer represented by those digits times
82237da2899SCharles.Forsyth * 10**e */
82337da2899SCharles.Forsyth
82437da2899SCharles.Forsyth if (!nd0)
82537da2899SCharles.Forsyth nd0 = nd;
82637da2899SCharles.Forsyth k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
82737da2899SCharles.Forsyth rv = y;
82837da2899SCharles.Forsyth if (k > 9)
82937da2899SCharles.Forsyth rv = tens[k - 9] * rv + z;
83037da2899SCharles.Forsyth bd0 = 0;
83137da2899SCharles.Forsyth if (nd <= DBL_DIG
83237da2899SCharles.Forsyth && FLT_ROUNDS == 1
83337da2899SCharles.Forsyth ) {
83437da2899SCharles.Forsyth if (!e)
83537da2899SCharles.Forsyth goto ret;
83637da2899SCharles.Forsyth if (e > 0) {
83737da2899SCharles.Forsyth if (e <= Ten_pmax) {
83837da2899SCharles.Forsyth /* rv = */ rounded_product(rv, tens[e]);
83937da2899SCharles.Forsyth goto ret;
84037da2899SCharles.Forsyth }
84137da2899SCharles.Forsyth i = DBL_DIG - nd;
84237da2899SCharles.Forsyth if (e <= Ten_pmax + i) {
84337da2899SCharles.Forsyth /* A fancier test would sometimes let us do
84437da2899SCharles.Forsyth * this for larger i values.
84537da2899SCharles.Forsyth */
84637da2899SCharles.Forsyth e -= i;
84737da2899SCharles.Forsyth rv *= tens[i];
84837da2899SCharles.Forsyth /* rv = */ rounded_product(rv, tens[e]);
84937da2899SCharles.Forsyth goto ret;
85037da2899SCharles.Forsyth }
85137da2899SCharles.Forsyth } else if (e >= -Ten_pmax) {
85237da2899SCharles.Forsyth /* rv = */ rounded_quotient(rv, tens[-e]);
85337da2899SCharles.Forsyth goto ret;
85437da2899SCharles.Forsyth }
85537da2899SCharles.Forsyth }
85637da2899SCharles.Forsyth e1 += nd - k;
85737da2899SCharles.Forsyth
85837da2899SCharles.Forsyth scale = 0;
85937da2899SCharles.Forsyth
86037da2899SCharles.Forsyth /* Get starting approximation = rv * 10**e1 */
86137da2899SCharles.Forsyth
86237da2899SCharles.Forsyth if (e1 > 0) {
86337da2899SCharles.Forsyth if (i = e1 & 15)
86437da2899SCharles.Forsyth rv *= tens[i];
86537da2899SCharles.Forsyth if (e1 &= ~15) {
86637da2899SCharles.Forsyth if (e1 > DBL_MAX_10_EXP) {
86737da2899SCharles.Forsyth ovfl:
86837da2899SCharles.Forsyth /* Can't trust HUGE_VAL */
86937da2899SCharles.Forsyth word0(rv) = Exp_mask;
87037da2899SCharles.Forsyth word1(rv) = 0;
87137da2899SCharles.Forsyth if (bd0)
87237da2899SCharles.Forsyth goto retfree;
87337da2899SCharles.Forsyth goto ret;
87437da2899SCharles.Forsyth }
87537da2899SCharles.Forsyth if (e1 >>= 4) {
87637da2899SCharles.Forsyth for (j = 0; e1 > 1; j++, e1 >>= 1)
87737da2899SCharles.Forsyth if (e1 & 1)
87837da2899SCharles.Forsyth rv *= bigtens[j];
87937da2899SCharles.Forsyth /* The last multiplication could overflow. */
88037da2899SCharles.Forsyth word0(rv) -= P * Exp_msk1;
88137da2899SCharles.Forsyth rv *= bigtens[j];
88237da2899SCharles.Forsyth if ((z = word0(rv) & Exp_mask)
88337da2899SCharles.Forsyth > Exp_msk1 * (DBL_MAX_EXP + Bias - P))
88437da2899SCharles.Forsyth goto ovfl;
88537da2899SCharles.Forsyth if (z > Exp_msk1 * (DBL_MAX_EXP + Bias - 1 - P)) {
88637da2899SCharles.Forsyth /* set to largest number */
88737da2899SCharles.Forsyth /* (Can't trust DBL_MAX) */
88837da2899SCharles.Forsyth word0(rv) = Big0;
88937da2899SCharles.Forsyth word1(rv) = Big1;
89037da2899SCharles.Forsyth } else
89137da2899SCharles.Forsyth word0(rv) += P * Exp_msk1;
89237da2899SCharles.Forsyth }
89337da2899SCharles.Forsyth
89437da2899SCharles.Forsyth }
89537da2899SCharles.Forsyth } else if (e1 < 0) {
89637da2899SCharles.Forsyth e1 = -e1;
89737da2899SCharles.Forsyth if (i = e1 & 15)
89837da2899SCharles.Forsyth rv /= tens[i];
89937da2899SCharles.Forsyth if (e1 &= ~15) {
90037da2899SCharles.Forsyth e1 >>= 4;
90137da2899SCharles.Forsyth if (e1 >= 1 << n_bigtens)
90237da2899SCharles.Forsyth goto undfl;
90337da2899SCharles.Forsyth if (e1 & Scale_Bit)
90437da2899SCharles.Forsyth scale = P;
90537da2899SCharles.Forsyth for (j = 0; e1 > 0; j++, e1 >>= 1)
90637da2899SCharles.Forsyth if (e1 & 1)
90737da2899SCharles.Forsyth rv *= tinytens[j];
90837da2899SCharles.Forsyth if (!rv) {
90937da2899SCharles.Forsyth undfl:
91037da2899SCharles.Forsyth rv = 0.;
91137da2899SCharles.Forsyth if (bd0)
91237da2899SCharles.Forsyth goto retfree;
91337da2899SCharles.Forsyth goto ret;
91437da2899SCharles.Forsyth }
91537da2899SCharles.Forsyth }
91637da2899SCharles.Forsyth }
91737da2899SCharles.Forsyth
91837da2899SCharles.Forsyth /* Now the hard part -- adjusting rv to the correct value.*/
91937da2899SCharles.Forsyth
92037da2899SCharles.Forsyth /* Put digits into bd: true value = bd * 10^e */
92137da2899SCharles.Forsyth
92237da2899SCharles.Forsyth bd0 = s2b(s0, nd0, nd, y);
92337da2899SCharles.Forsyth
92437da2899SCharles.Forsyth for (; ; ) {
92537da2899SCharles.Forsyth bd = Balloc(bd0->k);
92637da2899SCharles.Forsyth Bcopy(bd, bd0);
92737da2899SCharles.Forsyth bb = d2b(rv, &bbe, &bbbits); /* rv = bb * 2^bbe */
92837da2899SCharles.Forsyth bs = i2b(1);
92937da2899SCharles.Forsyth
93037da2899SCharles.Forsyth if (e >= 0) {
93137da2899SCharles.Forsyth bb2 = bb5 = 0;
93237da2899SCharles.Forsyth bd2 = bd5 = e;
93337da2899SCharles.Forsyth } else {
93437da2899SCharles.Forsyth bb2 = bb5 = -e;
93537da2899SCharles.Forsyth bd2 = bd5 = 0;
93637da2899SCharles.Forsyth }
93737da2899SCharles.Forsyth if (bbe >= 0)
93837da2899SCharles.Forsyth bb2 += bbe;
93937da2899SCharles.Forsyth else
94037da2899SCharles.Forsyth bd2 -= bbe;
94137da2899SCharles.Forsyth bs2 = bb2;
94237da2899SCharles.Forsyth #ifdef Sudden_Underflow
94337da2899SCharles.Forsyth j = P + 1 - bbbits;
94437da2899SCharles.Forsyth #else
94537da2899SCharles.Forsyth i = bbe + bbbits - 1; /* logb(rv) */
94637da2899SCharles.Forsyth if (i < Emin) /* denormal */
94737da2899SCharles.Forsyth j = bbe + (P - Emin);
94837da2899SCharles.Forsyth else
94937da2899SCharles.Forsyth j = P + 1 - bbbits;
95037da2899SCharles.Forsyth #endif
95137da2899SCharles.Forsyth bb2 += j;
95237da2899SCharles.Forsyth bd2 += j;
95337da2899SCharles.Forsyth bd2 += scale;
95437da2899SCharles.Forsyth i = bb2 < bd2 ? bb2 : bd2;
95537da2899SCharles.Forsyth if (i > bs2)
95637da2899SCharles.Forsyth i = bs2;
95737da2899SCharles.Forsyth if (i > 0) {
95837da2899SCharles.Forsyth bb2 -= i;
95937da2899SCharles.Forsyth bd2 -= i;
96037da2899SCharles.Forsyth bs2 -= i;
96137da2899SCharles.Forsyth }
96237da2899SCharles.Forsyth if (bb5 > 0) {
96337da2899SCharles.Forsyth bs = pow5mult(bs, bb5);
96437da2899SCharles.Forsyth bb1 = mult(bs, bb);
96537da2899SCharles.Forsyth Bfree(bb);
96637da2899SCharles.Forsyth bb = bb1;
96737da2899SCharles.Forsyth }
96837da2899SCharles.Forsyth if (bb2 > 0)
96937da2899SCharles.Forsyth bb = lshift(bb, bb2);
97037da2899SCharles.Forsyth if (bd5 > 0)
97137da2899SCharles.Forsyth bd = pow5mult(bd, bd5);
97237da2899SCharles.Forsyth if (bd2 > 0)
97337da2899SCharles.Forsyth bd = lshift(bd, bd2);
97437da2899SCharles.Forsyth if (bs2 > 0)
97537da2899SCharles.Forsyth bs = lshift(bs, bs2);
97637da2899SCharles.Forsyth delta = diff(bb, bd);
97737da2899SCharles.Forsyth dsign = delta->sign;
97837da2899SCharles.Forsyth delta->sign = 0;
97937da2899SCharles.Forsyth i = cmp(delta, bs);
98037da2899SCharles.Forsyth if (i < 0) {
98137da2899SCharles.Forsyth /* Error is less than half an ulp -- check for
98237da2899SCharles.Forsyth * special case of mantissa a power of two.
98337da2899SCharles.Forsyth */
98437da2899SCharles.Forsyth if (dsign || word1(rv) || word0(rv) & Bndry_mask
98537da2899SCharles.Forsyth || (word0(rv) & Exp_mask) <= Exp_msk1
98637da2899SCharles.Forsyth ) {
98737da2899SCharles.Forsyth if (!delta->x[0] && delta->wds == 1)
98837da2899SCharles.Forsyth dsign = 2;
98937da2899SCharles.Forsyth break;
99037da2899SCharles.Forsyth }
99137da2899SCharles.Forsyth delta = lshift(delta, Log2P);
99237da2899SCharles.Forsyth if (cmp(delta, bs) > 0)
99337da2899SCharles.Forsyth goto drop_down;
99437da2899SCharles.Forsyth break;
99537da2899SCharles.Forsyth }
99637da2899SCharles.Forsyth if (i == 0) {
99737da2899SCharles.Forsyth /* exactly half-way between */
99837da2899SCharles.Forsyth if (dsign) {
99937da2899SCharles.Forsyth if ((word0(rv) & Bndry_mask1) == Bndry_mask1
100037da2899SCharles.Forsyth && word1(rv) == 0xffffffff) {
100137da2899SCharles.Forsyth /*boundary case -- increment exponent*/
100237da2899SCharles.Forsyth word0(rv) = (word0(rv) & Exp_mask)
100337da2899SCharles.Forsyth + Exp_msk1
100437da2899SCharles.Forsyth ;
100537da2899SCharles.Forsyth word1(rv) = 0;
100637da2899SCharles.Forsyth dsign = 0;
100737da2899SCharles.Forsyth break;
100837da2899SCharles.Forsyth }
100937da2899SCharles.Forsyth } else if (!(word0(rv) & Bndry_mask) && !word1(rv)) {
101037da2899SCharles.Forsyth dsign = 2;
101137da2899SCharles.Forsyth drop_down:
101237da2899SCharles.Forsyth /* boundary case -- decrement exponent */
101337da2899SCharles.Forsyth #ifdef Sudden_Underflow
101437da2899SCharles.Forsyth L = word0(rv) & Exp_mask;
101537da2899SCharles.Forsyth if (L <= Exp_msk1)
101637da2899SCharles.Forsyth goto undfl;
101737da2899SCharles.Forsyth L -= Exp_msk1;
101837da2899SCharles.Forsyth #else
101937da2899SCharles.Forsyth L = (word0(rv) & Exp_mask) - Exp_msk1;
102037da2899SCharles.Forsyth #endif
102137da2899SCharles.Forsyth word0(rv) = L | Bndry_mask1;
102237da2899SCharles.Forsyth word1(rv) = 0xffffffff;
102337da2899SCharles.Forsyth break;
102437da2899SCharles.Forsyth }
102537da2899SCharles.Forsyth if (!(word1(rv) & LSB))
102637da2899SCharles.Forsyth break;
102737da2899SCharles.Forsyth if (dsign)
102837da2899SCharles.Forsyth rv += ulp(rv);
102937da2899SCharles.Forsyth else {
103037da2899SCharles.Forsyth rv -= ulp(rv);
103137da2899SCharles.Forsyth #ifndef Sudden_Underflow
103237da2899SCharles.Forsyth if (!rv)
103337da2899SCharles.Forsyth goto undfl;
103437da2899SCharles.Forsyth #endif
103537da2899SCharles.Forsyth }
103637da2899SCharles.Forsyth dsign = 1 - dsign;
103737da2899SCharles.Forsyth break;
103837da2899SCharles.Forsyth }
103937da2899SCharles.Forsyth if ((aadj = ratio(delta, bs)) <= 2.) {
104037da2899SCharles.Forsyth if (dsign)
104137da2899SCharles.Forsyth aadj = aadj1 = 1.;
104237da2899SCharles.Forsyth else if (word1(rv) || word0(rv) & Bndry_mask) {
104337da2899SCharles.Forsyth #ifndef Sudden_Underflow
104437da2899SCharles.Forsyth if (word1(rv) == Tiny1 && !word0(rv))
104537da2899SCharles.Forsyth goto undfl;
104637da2899SCharles.Forsyth #endif
104737da2899SCharles.Forsyth aadj = 1.;
104837da2899SCharles.Forsyth aadj1 = -1.;
104937da2899SCharles.Forsyth } else {
105037da2899SCharles.Forsyth /* special case -- power of FLT_RADIX to be */
105137da2899SCharles.Forsyth /* rounded down... */
105237da2899SCharles.Forsyth
105337da2899SCharles.Forsyth if (aadj < 2. / FLT_RADIX)
105437da2899SCharles.Forsyth aadj = 1. / FLT_RADIX;
105537da2899SCharles.Forsyth else
105637da2899SCharles.Forsyth aadj *= 0.5;
105737da2899SCharles.Forsyth aadj1 = -aadj;
105837da2899SCharles.Forsyth }
105937da2899SCharles.Forsyth } else {
106037da2899SCharles.Forsyth aadj *= 0.5;
106137da2899SCharles.Forsyth aadj1 = dsign ? aadj : -aadj;
106237da2899SCharles.Forsyth if (FLT_ROUNDS == 0)
106337da2899SCharles.Forsyth aadj1 += 0.5;
106437da2899SCharles.Forsyth }
106537da2899SCharles.Forsyth y = word0(rv) & Exp_mask;
106637da2899SCharles.Forsyth
106737da2899SCharles.Forsyth /* Check for overflow */
106837da2899SCharles.Forsyth
106937da2899SCharles.Forsyth if (y == Exp_msk1 * (DBL_MAX_EXP + Bias - 1)) {
107037da2899SCharles.Forsyth rv0 = rv;
107137da2899SCharles.Forsyth word0(rv) -= P * Exp_msk1;
107237da2899SCharles.Forsyth adj = aadj1 * ulp(rv);
107337da2899SCharles.Forsyth rv += adj;
107437da2899SCharles.Forsyth if ((word0(rv) & Exp_mask) >=
107537da2899SCharles.Forsyth Exp_msk1 * (DBL_MAX_EXP + Bias - P)) {
107637da2899SCharles.Forsyth if (word0(rv0) == Big0 && word1(rv0) == Big1)
107737da2899SCharles.Forsyth goto ovfl;
107837da2899SCharles.Forsyth word0(rv) = Big0;
107937da2899SCharles.Forsyth word1(rv) = Big1;
108037da2899SCharles.Forsyth goto cont;
108137da2899SCharles.Forsyth } else
108237da2899SCharles.Forsyth word0(rv) += P * Exp_msk1;
108337da2899SCharles.Forsyth } else {
108437da2899SCharles.Forsyth #ifdef Sudden_Underflow
108537da2899SCharles.Forsyth if ((word0(rv) & Exp_mask) <= P * Exp_msk1) {
108637da2899SCharles.Forsyth rv0 = rv;
108737da2899SCharles.Forsyth word0(rv) += P * Exp_msk1;
108837da2899SCharles.Forsyth adj = aadj1 * ulp(rv);
108937da2899SCharles.Forsyth rv += adj;
109037da2899SCharles.Forsyth if ((word0(rv) & Exp_mask) <= P * Exp_msk1) {
109137da2899SCharles.Forsyth if (word0(rv0) == Tiny0
109237da2899SCharles.Forsyth && word1(rv0) == Tiny1)
109337da2899SCharles.Forsyth goto undfl;
109437da2899SCharles.Forsyth word0(rv) = Tiny0;
109537da2899SCharles.Forsyth word1(rv) = Tiny1;
109637da2899SCharles.Forsyth goto cont;
109737da2899SCharles.Forsyth } else
109837da2899SCharles.Forsyth word0(rv) -= P * Exp_msk1;
109937da2899SCharles.Forsyth } else {
110037da2899SCharles.Forsyth adj = aadj1 * ulp(rv);
110137da2899SCharles.Forsyth rv += adj;
110237da2899SCharles.Forsyth }
110337da2899SCharles.Forsyth #else
110437da2899SCharles.Forsyth /* Compute adj so that the IEEE rounding rules will
110537da2899SCharles.Forsyth * correctly round rv + adj in some half-way cases.
110637da2899SCharles.Forsyth * If rv * ulp(rv) is denormalized (i.e.,
110737da2899SCharles.Forsyth * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
110837da2899SCharles.Forsyth * trouble from bits lost to denormalization;
110937da2899SCharles.Forsyth * example: 1.2e-307 .
111037da2899SCharles.Forsyth */
111137da2899SCharles.Forsyth if (y <= (P - 1) * Exp_msk1 && aadj >= 1.) {
111237da2899SCharles.Forsyth aadj1 = (double)(int)(aadj + 0.5);
111337da2899SCharles.Forsyth if (!dsign)
111437da2899SCharles.Forsyth aadj1 = -aadj1;
111537da2899SCharles.Forsyth }
111637da2899SCharles.Forsyth adj = aadj1 * ulp(rv);
111737da2899SCharles.Forsyth rv += adj;
111837da2899SCharles.Forsyth #endif
111937da2899SCharles.Forsyth }
112037da2899SCharles.Forsyth z = word0(rv) & Exp_mask;
112137da2899SCharles.Forsyth if (!scale)
112237da2899SCharles.Forsyth if (y == z) {
112337da2899SCharles.Forsyth /* Can we stop now? */
112437da2899SCharles.Forsyth L = aadj;
112537da2899SCharles.Forsyth aadj -= L;
112637da2899SCharles.Forsyth /* The tolerances below are conservative. */
112737da2899SCharles.Forsyth if (dsign || word1(rv) || word0(rv) & Bndry_mask) {
112837da2899SCharles.Forsyth if (aadj < .4999999 || aadj > .5000001)
112937da2899SCharles.Forsyth break;
113037da2899SCharles.Forsyth } else if (aadj < .4999999 / FLT_RADIX)
113137da2899SCharles.Forsyth break;
113237da2899SCharles.Forsyth }
113337da2899SCharles.Forsyth cont:
113437da2899SCharles.Forsyth Bfree(bb);
113537da2899SCharles.Forsyth Bfree(bd);
113637da2899SCharles.Forsyth Bfree(bs);
113737da2899SCharles.Forsyth Bfree(delta);
113837da2899SCharles.Forsyth }
113937da2899SCharles.Forsyth if (scale) {
114037da2899SCharles.Forsyth if ((word0(rv) & Exp_mask) <= P * Exp_msk1
114137da2899SCharles.Forsyth && word1(rv) & 1
114237da2899SCharles.Forsyth && dsign != 2)
114337da2899SCharles.Forsyth if (dsign)
114437da2899SCharles.Forsyth rv += ulp(rv);
114537da2899SCharles.Forsyth else
114637da2899SCharles.Forsyth word1(rv) &= ~1;
114737da2899SCharles.Forsyth word0(rv0) = Exp_1 - P * Exp_msk1;
114837da2899SCharles.Forsyth word1(rv0) = 0;
114937da2899SCharles.Forsyth rv *= rv0;
115037da2899SCharles.Forsyth }
115137da2899SCharles.Forsyth retfree:
115237da2899SCharles.Forsyth Bfree(bb);
115337da2899SCharles.Forsyth Bfree(bd);
115437da2899SCharles.Forsyth Bfree(bs);
115537da2899SCharles.Forsyth Bfree(bd0);
115637da2899SCharles.Forsyth Bfree(delta);
115737da2899SCharles.Forsyth ret:
115837da2899SCharles.Forsyth if (se)
115937da2899SCharles.Forsyth *se = (char *)s;
116037da2899SCharles.Forsyth return sign ? -rv : rv;
116137da2899SCharles.Forsyth }
116237da2899SCharles.Forsyth
116337da2899SCharles.Forsyth static int
quorem(Bigint * b,Bigint * S)116437da2899SCharles.Forsyth quorem(Bigint *b, Bigint *S)
116537da2899SCharles.Forsyth {
116637da2899SCharles.Forsyth int n;
116737da2899SCharles.Forsyth long borrow, y;
116837da2899SCharles.Forsyth unsigned long carry, q, ys;
116937da2899SCharles.Forsyth unsigned long * bx, *bxe, *sx, *sxe;
117037da2899SCharles.Forsyth long z;
117137da2899SCharles.Forsyth unsigned long si, zs;
117237da2899SCharles.Forsyth
117337da2899SCharles.Forsyth n = S->wds;
117437da2899SCharles.Forsyth if (b->wds < n)
117537da2899SCharles.Forsyth return 0;
117637da2899SCharles.Forsyth sx = S->x;
117737da2899SCharles.Forsyth sxe = sx + --n;
117837da2899SCharles.Forsyth bx = b->x;
117937da2899SCharles.Forsyth bxe = bx + n;
118037da2899SCharles.Forsyth q = *bxe / (*sxe + 1); /* ensure q <= true quotient */
118137da2899SCharles.Forsyth if (q) {
118237da2899SCharles.Forsyth borrow = 0;
118337da2899SCharles.Forsyth carry = 0;
118437da2899SCharles.Forsyth do {
118537da2899SCharles.Forsyth si = *sx++;
118637da2899SCharles.Forsyth ys = (si & 0xffff) * q + carry;
118737da2899SCharles.Forsyth zs = (si >> 16) * q + (ys >> 16);
118837da2899SCharles.Forsyth carry = zs >> 16;
118937da2899SCharles.Forsyth y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
119037da2899SCharles.Forsyth borrow = y >> 16;
119137da2899SCharles.Forsyth Sign_Extend(borrow, y);
119237da2899SCharles.Forsyth z = (*bx >> 16) - (zs & 0xffff) + borrow;
119337da2899SCharles.Forsyth borrow = z >> 16;
119437da2899SCharles.Forsyth Sign_Extend(borrow, z);
119537da2899SCharles.Forsyth Storeinc(bx, z, y);
119637da2899SCharles.Forsyth } while (sx <= sxe);
119737da2899SCharles.Forsyth if (!*bxe) {
119837da2899SCharles.Forsyth bx = b->x;
119937da2899SCharles.Forsyth while (--bxe > bx && !*bxe)
120037da2899SCharles.Forsyth --n;
120137da2899SCharles.Forsyth b->wds = n;
120237da2899SCharles.Forsyth }
120337da2899SCharles.Forsyth }
120437da2899SCharles.Forsyth if (cmp(b, S) >= 0) {
120537da2899SCharles.Forsyth q++;
120637da2899SCharles.Forsyth borrow = 0;
120737da2899SCharles.Forsyth carry = 0;
120837da2899SCharles.Forsyth bx = b->x;
120937da2899SCharles.Forsyth sx = S->x;
121037da2899SCharles.Forsyth do {
121137da2899SCharles.Forsyth si = *sx++;
121237da2899SCharles.Forsyth ys = (si & 0xffff) + carry;
121337da2899SCharles.Forsyth zs = (si >> 16) + (ys >> 16);
121437da2899SCharles.Forsyth carry = zs >> 16;
121537da2899SCharles.Forsyth y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
121637da2899SCharles.Forsyth borrow = y >> 16;
121737da2899SCharles.Forsyth Sign_Extend(borrow, y);
121837da2899SCharles.Forsyth z = (*bx >> 16) - (zs & 0xffff) + borrow;
121937da2899SCharles.Forsyth borrow = z >> 16;
122037da2899SCharles.Forsyth Sign_Extend(borrow, z);
122137da2899SCharles.Forsyth Storeinc(bx, z, y);
122237da2899SCharles.Forsyth } while (sx <= sxe);
122337da2899SCharles.Forsyth bx = b->x;
122437da2899SCharles.Forsyth bxe = bx + n;
122537da2899SCharles.Forsyth if (!*bxe) {
122637da2899SCharles.Forsyth while (--bxe > bx && !*bxe)
122737da2899SCharles.Forsyth --n;
122837da2899SCharles.Forsyth b->wds = n;
122937da2899SCharles.Forsyth }
123037da2899SCharles.Forsyth }
123137da2899SCharles.Forsyth return q;
123237da2899SCharles.Forsyth }
123337da2899SCharles.Forsyth
123437da2899SCharles.Forsyth static char *
rv_alloc(int i)123537da2899SCharles.Forsyth rv_alloc(int i)
123637da2899SCharles.Forsyth {
123737da2899SCharles.Forsyth int j, k, *r;
123837da2899SCharles.Forsyth
123937da2899SCharles.Forsyth j = sizeof(unsigned long);
124037da2899SCharles.Forsyth for (k = 0;
124137da2899SCharles.Forsyth sizeof(Bigint) - sizeof(unsigned long) - sizeof(int) + j <= i;
124237da2899SCharles.Forsyth j <<= 1)
124337da2899SCharles.Forsyth k++;
124437da2899SCharles.Forsyth r = (int * )Balloc(k);
124537da2899SCharles.Forsyth *r = k;
124637da2899SCharles.Forsyth return
124737da2899SCharles.Forsyth (char *)(r + 1);
124837da2899SCharles.Forsyth }
124937da2899SCharles.Forsyth
125037da2899SCharles.Forsyth static char *
nrv_alloc(char * s,char ** rve,int n)125137da2899SCharles.Forsyth nrv_alloc(char *s, char **rve, int n)
125237da2899SCharles.Forsyth {
125337da2899SCharles.Forsyth char *rv, *t;
125437da2899SCharles.Forsyth
125537da2899SCharles.Forsyth t = rv = rv_alloc(n);
125637da2899SCharles.Forsyth while (*t = *s++)
125737da2899SCharles.Forsyth t++;
125837da2899SCharles.Forsyth if (rve)
125937da2899SCharles.Forsyth *rve = t;
126037da2899SCharles.Forsyth return rv;
126137da2899SCharles.Forsyth }
126237da2899SCharles.Forsyth
126337da2899SCharles.Forsyth /* freedtoa(s) must be used to free values s returned by dtoa
126437da2899SCharles.Forsyth * when MULTIPLE_THREADS is #defined. It should be used in all cases,
126537da2899SCharles.Forsyth * but for consistency with earlier versions of dtoa, it is optional
126637da2899SCharles.Forsyth * when MULTIPLE_THREADS is not defined.
126737da2899SCharles.Forsyth */
126837da2899SCharles.Forsyth
126937da2899SCharles.Forsyth void
freedtoa(char * s)127037da2899SCharles.Forsyth freedtoa(char *s)
127137da2899SCharles.Forsyth {
127237da2899SCharles.Forsyth Bigint * b = (Bigint * )((int *)s - 1);
127337da2899SCharles.Forsyth b->maxwds = 1 << (b->k = *(int * )b);
127437da2899SCharles.Forsyth Bfree(b);
127537da2899SCharles.Forsyth }
127637da2899SCharles.Forsyth
127737da2899SCharles.Forsyth /* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
127837da2899SCharles.Forsyth *
127937da2899SCharles.Forsyth * Inspired by "How to Print Floating-Point Numbers Accurately" by
128037da2899SCharles.Forsyth * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 92-101].
128137da2899SCharles.Forsyth *
128237da2899SCharles.Forsyth * Modifications:
128337da2899SCharles.Forsyth * 1. Rather than iterating, we use a simple numeric overestimate
128437da2899SCharles.Forsyth * to determine k = floor(log10(d)). We scale relevant
128537da2899SCharles.Forsyth * quantities using O(log2(k)) rather than O(k) multiplications.
128637da2899SCharles.Forsyth * 2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
128737da2899SCharles.Forsyth * try to generate digits strictly left to right. Instead, we
128837da2899SCharles.Forsyth * compute with fewer bits and propagate the carry if necessary
128937da2899SCharles.Forsyth * when rounding the final digit up. This is often faster.
129037da2899SCharles.Forsyth * 3. Under the assumption that input will be rounded nearest,
129137da2899SCharles.Forsyth * mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
129237da2899SCharles.Forsyth * That is, we allow equality in stopping tests when the
129337da2899SCharles.Forsyth * round-nearest rule will give the same floating-point value
129437da2899SCharles.Forsyth * as would satisfaction of the stopping test with strict
129537da2899SCharles.Forsyth * inequality.
129637da2899SCharles.Forsyth * 4. We remove common factors of powers of 2 from relevant
129737da2899SCharles.Forsyth * quantities.
129837da2899SCharles.Forsyth * 5. When converting floating-point integers less than 1e16,
129937da2899SCharles.Forsyth * we use floating-point arithmetic rather than resorting
130037da2899SCharles.Forsyth * to multiple-precision integers.
130137da2899SCharles.Forsyth * 6. When asked to produce fewer than 15 digits, we first try
130237da2899SCharles.Forsyth * to get by with floating-point arithmetic; we resort to
130337da2899SCharles.Forsyth * multiple-precision integer arithmetic only if we cannot
130437da2899SCharles.Forsyth * guarantee that the floating-point calculation has given
130537da2899SCharles.Forsyth * the correctly rounded result. For k requested digits and
130637da2899SCharles.Forsyth * "uniformly" distributed input, the probability is
130737da2899SCharles.Forsyth * something like 10^(k-15) that we must resort to the long
130837da2899SCharles.Forsyth * calculation.
130937da2899SCharles.Forsyth */
131037da2899SCharles.Forsyth
131137da2899SCharles.Forsyth char *
dtoa(double d,int mode,int ndigits,int * decpt,int * sign,char ** rve)131237da2899SCharles.Forsyth dtoa(double d, int mode, int ndigits, int *decpt, int *sign, char **rve)
131337da2899SCharles.Forsyth {
131437da2899SCharles.Forsyth /* Arguments ndigits, decpt, sign are similar to those
131537da2899SCharles.Forsyth of ecvt and fcvt; trailing zeros are suppressed from
131637da2899SCharles.Forsyth the returned string. If not null, *rve is set to point
131737da2899SCharles.Forsyth to the end of the return value. If d is +-Infinity or NaN,
131837da2899SCharles.Forsyth then *decpt is set to 9999.
131937da2899SCharles.Forsyth
132037da2899SCharles.Forsyth mode:
132137da2899SCharles.Forsyth 0 ==> shortest string that yields d when read in
132237da2899SCharles.Forsyth and rounded to nearest.
132337da2899SCharles.Forsyth 1 ==> like 0, but with Steele & White stopping rule;
132437da2899SCharles.Forsyth e.g. with IEEE P754 arithmetic , mode 0 gives
132537da2899SCharles.Forsyth 1e23 whereas mode 1 gives 9.999999999999999e22.
132637da2899SCharles.Forsyth 2 ==> max(1,ndigits) significant digits. This gives a
132737da2899SCharles.Forsyth return value similar to that of ecvt, except
132837da2899SCharles.Forsyth that trailing zeros are suppressed.
132937da2899SCharles.Forsyth 3 ==> through ndigits past the decimal point. This
133037da2899SCharles.Forsyth gives a return value similar to that from fcvt,
133137da2899SCharles.Forsyth except that trailing zeros are suppressed, and
133237da2899SCharles.Forsyth ndigits can be negative.
133337da2899SCharles.Forsyth 4-9 should give the same return values as 2-3, i.e.,
133437da2899SCharles.Forsyth 4 <= mode <= 9 ==> same return as mode
133537da2899SCharles.Forsyth 2 + (mode & 1). These modes are mainly for
133637da2899SCharles.Forsyth debugging; often they run slower but sometimes
133737da2899SCharles.Forsyth faster than modes 2-3.
133837da2899SCharles.Forsyth 4,5,8,9 ==> left-to-right digit generation.
133937da2899SCharles.Forsyth 6-9 ==> don't try fast floating-point estimate
134037da2899SCharles.Forsyth (if applicable).
134137da2899SCharles.Forsyth
134237da2899SCharles.Forsyth Values of mode other than 0-9 are treated as mode 0.
134337da2899SCharles.Forsyth
134437da2899SCharles.Forsyth Sufficient space is allocated to the return value
134537da2899SCharles.Forsyth to hold the suppressed trailing zeros.
134637da2899SCharles.Forsyth */
134737da2899SCharles.Forsyth
134837da2899SCharles.Forsyth int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1,
134937da2899SCharles.Forsyth j, j1, k, k0, k_check, leftright, m2, m5, s2, s5,
135037da2899SCharles.Forsyth spec_case, try_quick;
135137da2899SCharles.Forsyth long L;
135237da2899SCharles.Forsyth #ifndef Sudden_Underflow
135337da2899SCharles.Forsyth int denorm;
135437da2899SCharles.Forsyth unsigned long x;
135537da2899SCharles.Forsyth #endif
135637da2899SCharles.Forsyth Bigint * b, *b1, *delta, *mlo, *mhi, *S;
135737da2899SCharles.Forsyth double d2, ds, eps;
135837da2899SCharles.Forsyth char *s, *s0;
135937da2899SCharles.Forsyth
136037da2899SCharles.Forsyth if (word0(d) & Sign_bit) {
136137da2899SCharles.Forsyth /* set sign for everything, including 0's and NaNs */
136237da2899SCharles.Forsyth *sign = 1;
136337da2899SCharles.Forsyth word0(d) &= ~Sign_bit; /* clear sign bit */
136437da2899SCharles.Forsyth } else
136537da2899SCharles.Forsyth *sign = 0;
136637da2899SCharles.Forsyth
136737da2899SCharles.Forsyth if ((word0(d) & Exp_mask) == Exp_mask) {
136837da2899SCharles.Forsyth /* Infinity or NaN */
136937da2899SCharles.Forsyth *decpt = 9999;
137037da2899SCharles.Forsyth if (!word1(d) && !(word0(d) & 0xfffff))
137137da2899SCharles.Forsyth return nrv_alloc("Infinity", rve, 8);
137237da2899SCharles.Forsyth return nrv_alloc("NaN", rve, 3);
137337da2899SCharles.Forsyth }
137437da2899SCharles.Forsyth if (!d) {
137537da2899SCharles.Forsyth *decpt = 1;
137637da2899SCharles.Forsyth return nrv_alloc("0", rve, 1);
137737da2899SCharles.Forsyth }
137837da2899SCharles.Forsyth
137937da2899SCharles.Forsyth b = d2b(d, &be, &bbits);
138037da2899SCharles.Forsyth #ifdef Sudden_Underflow
138137da2899SCharles.Forsyth i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1));
138237da2899SCharles.Forsyth #else
138337da2899SCharles.Forsyth if (i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1))) {
138437da2899SCharles.Forsyth #endif
13851892ac4bSCharles.Forsyth word0(d2) = (word0(d) & Frac_mask1) | Exp_11;
13861892ac4bSCharles.Forsyth word1(d2) = word1(d);
138737da2899SCharles.Forsyth
138837da2899SCharles.Forsyth /* log(x) ~=~ log(1.5) + (x-1.5)/1.5
138937da2899SCharles.Forsyth * log10(x) = log(x) / log(10)
139037da2899SCharles.Forsyth * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
139137da2899SCharles.Forsyth * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
139237da2899SCharles.Forsyth *
139337da2899SCharles.Forsyth * This suggests computing an approximation k to log10(d) by
139437da2899SCharles.Forsyth *
139537da2899SCharles.Forsyth * k = (i - Bias)*0.301029995663981
139637da2899SCharles.Forsyth * + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
139737da2899SCharles.Forsyth *
139837da2899SCharles.Forsyth * We want k to be too large rather than too small.
139937da2899SCharles.Forsyth * The error in the first-order Taylor series approximation
140037da2899SCharles.Forsyth * is in our favor, so we just round up the constant enough
140137da2899SCharles.Forsyth * to compensate for any error in the multiplication of
140237da2899SCharles.Forsyth * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
140337da2899SCharles.Forsyth * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
140437da2899SCharles.Forsyth * adding 1e-13 to the constant term more than suffices.
140537da2899SCharles.Forsyth * Hence we adjust the constant term to 0.1760912590558.
140637da2899SCharles.Forsyth * (We could get a more accurate k by invoking log10,
140737da2899SCharles.Forsyth * but this is probably not worthwhile.)
140837da2899SCharles.Forsyth */
140937da2899SCharles.Forsyth
141037da2899SCharles.Forsyth i -= Bias;
141137da2899SCharles.Forsyth #ifndef Sudden_Underflow
141237da2899SCharles.Forsyth denorm = 0;
141337da2899SCharles.Forsyth } else {
141437da2899SCharles.Forsyth /* d is denormalized */
141537da2899SCharles.Forsyth
141637da2899SCharles.Forsyth i = bbits + be + (Bias + (P - 1) - 1);
141737da2899SCharles.Forsyth x = i > 32 ? word0(d) << 64 - i | word1(d) >> i - 32
141837da2899SCharles.Forsyth : word1(d) << 32 - i;
141937da2899SCharles.Forsyth d2 = x;
142037da2899SCharles.Forsyth word0(d2) -= 31 * Exp_msk1; /* adjust exponent */
142137da2899SCharles.Forsyth i -= (Bias + (P - 1) - 1) + 1;
142237da2899SCharles.Forsyth denorm = 1;
142337da2899SCharles.Forsyth }
142437da2899SCharles.Forsyth #endif
142537da2899SCharles.Forsyth ds = (d2 - 1.5) * 0.289529654602168 + 0.1760912590558 + i * 0.301029995663981;
142637da2899SCharles.Forsyth k = (int)ds;
142737da2899SCharles.Forsyth if (ds < 0. && ds != k)
142837da2899SCharles.Forsyth k--; /* want k = floor(ds) */
142937da2899SCharles.Forsyth k_check = 1;
143037da2899SCharles.Forsyth if (k >= 0 && k <= Ten_pmax) {
143137da2899SCharles.Forsyth if (d < tens[k])
143237da2899SCharles.Forsyth k--;
143337da2899SCharles.Forsyth k_check = 0;
143437da2899SCharles.Forsyth }
143537da2899SCharles.Forsyth j = bbits - i - 1;
143637da2899SCharles.Forsyth if (j >= 0) {
143737da2899SCharles.Forsyth b2 = 0;
143837da2899SCharles.Forsyth s2 = j;
143937da2899SCharles.Forsyth } else {
144037da2899SCharles.Forsyth b2 = -j;
144137da2899SCharles.Forsyth s2 = 0;
144237da2899SCharles.Forsyth }
144337da2899SCharles.Forsyth if (k >= 0) {
144437da2899SCharles.Forsyth b5 = 0;
144537da2899SCharles.Forsyth s5 = k;
144637da2899SCharles.Forsyth s2 += k;
144737da2899SCharles.Forsyth } else {
144837da2899SCharles.Forsyth b2 -= k;
144937da2899SCharles.Forsyth b5 = -k;
145037da2899SCharles.Forsyth s5 = 0;
145137da2899SCharles.Forsyth }
145237da2899SCharles.Forsyth if (mode < 0 || mode > 9)
145337da2899SCharles.Forsyth mode = 0;
145437da2899SCharles.Forsyth try_quick = 1;
145537da2899SCharles.Forsyth if (mode > 5) {
145637da2899SCharles.Forsyth mode -= 4;
145737da2899SCharles.Forsyth try_quick = 0;
145837da2899SCharles.Forsyth }
145937da2899SCharles.Forsyth leftright = 1;
146037da2899SCharles.Forsyth switch (mode) {
146137da2899SCharles.Forsyth case 0:
146237da2899SCharles.Forsyth case 1:
146337da2899SCharles.Forsyth ilim = ilim1 = -1;
146437da2899SCharles.Forsyth i = 18;
146537da2899SCharles.Forsyth ndigits = 0;
146637da2899SCharles.Forsyth break;
146737da2899SCharles.Forsyth case 2:
146837da2899SCharles.Forsyth leftright = 0;
146937da2899SCharles.Forsyth /* no break */
147037da2899SCharles.Forsyth case 4:
147137da2899SCharles.Forsyth if (ndigits <= 0)
147237da2899SCharles.Forsyth ndigits = 1;
147337da2899SCharles.Forsyth ilim = ilim1 = i = ndigits;
147437da2899SCharles.Forsyth break;
147537da2899SCharles.Forsyth case 3:
147637da2899SCharles.Forsyth leftright = 0;
147737da2899SCharles.Forsyth /* no break */
147837da2899SCharles.Forsyth case 5:
147937da2899SCharles.Forsyth i = ndigits + k + 1;
148037da2899SCharles.Forsyth ilim = i;
148137da2899SCharles.Forsyth ilim1 = i - 1;
148237da2899SCharles.Forsyth if (i <= 0)
148337da2899SCharles.Forsyth i = 1;
148437da2899SCharles.Forsyth }
148537da2899SCharles.Forsyth s = s0 = rv_alloc(i);
148637da2899SCharles.Forsyth
148737da2899SCharles.Forsyth if (ilim >= 0 && ilim <= Quick_max && try_quick) {
148837da2899SCharles.Forsyth
148937da2899SCharles.Forsyth /* Try to get by with floating-point arithmetic. */
149037da2899SCharles.Forsyth
149137da2899SCharles.Forsyth i = 0;
149237da2899SCharles.Forsyth d2 = d;
149337da2899SCharles.Forsyth k0 = k;
149437da2899SCharles.Forsyth ilim0 = ilim;
149537da2899SCharles.Forsyth ieps = 2; /* conservative */
149637da2899SCharles.Forsyth if (k > 0) {
149737da2899SCharles.Forsyth ds = tens[k&0xf];
149837da2899SCharles.Forsyth j = k >> 4;
149937da2899SCharles.Forsyth if (j & Bletch) {
150037da2899SCharles.Forsyth /* prevent overflows */
150137da2899SCharles.Forsyth j &= Bletch - 1;
150237da2899SCharles.Forsyth d /= bigtens[n_bigtens-1];
150337da2899SCharles.Forsyth ieps++;
150437da2899SCharles.Forsyth }
150537da2899SCharles.Forsyth for (; j; j >>= 1, i++)
150637da2899SCharles.Forsyth if (j & 1) {
150737da2899SCharles.Forsyth ieps++;
150837da2899SCharles.Forsyth ds *= bigtens[i];
150937da2899SCharles.Forsyth }
151037da2899SCharles.Forsyth d /= ds;
151137da2899SCharles.Forsyth } else if (j1 = -k) {
151237da2899SCharles.Forsyth d *= tens[j1 & 0xf];
151337da2899SCharles.Forsyth for (j = j1 >> 4; j; j >>= 1, i++)
151437da2899SCharles.Forsyth if (j & 1) {
151537da2899SCharles.Forsyth ieps++;
151637da2899SCharles.Forsyth d *= bigtens[i];
151737da2899SCharles.Forsyth }
151837da2899SCharles.Forsyth }
151937da2899SCharles.Forsyth if (k_check && d < 1. && ilim > 0) {
152037da2899SCharles.Forsyth if (ilim1 <= 0)
152137da2899SCharles.Forsyth goto fast_failed;
152237da2899SCharles.Forsyth ilim = ilim1;
152337da2899SCharles.Forsyth k--;
152437da2899SCharles.Forsyth d *= 10.;
152537da2899SCharles.Forsyth ieps++;
152637da2899SCharles.Forsyth }
152737da2899SCharles.Forsyth eps = ieps * d + 7.;
152837da2899SCharles.Forsyth word0(eps) -= (P - 1) * Exp_msk1;
152937da2899SCharles.Forsyth if (ilim == 0) {
153037da2899SCharles.Forsyth S = mhi = 0;
153137da2899SCharles.Forsyth d -= 5.;
153237da2899SCharles.Forsyth if (d > eps)
153337da2899SCharles.Forsyth goto one_digit;
153437da2899SCharles.Forsyth if (d < -eps)
153537da2899SCharles.Forsyth goto no_digits;
153637da2899SCharles.Forsyth goto fast_failed;
153737da2899SCharles.Forsyth }
153837da2899SCharles.Forsyth /* Generate ilim digits, then fix them up. */
153937da2899SCharles.Forsyth eps *= tens[ilim-1];
154037da2899SCharles.Forsyth for (i = 1; ; i++, d *= 10.) {
154137da2899SCharles.Forsyth L = d;
154237da2899SCharles.Forsyth d -= L;
154337da2899SCharles.Forsyth *s++ = '0' + (int)L;
154437da2899SCharles.Forsyth if (i == ilim) {
154537da2899SCharles.Forsyth if (d > 0.5 + eps)
154637da2899SCharles.Forsyth goto bump_up;
154737da2899SCharles.Forsyth else if (d < 0.5 - eps) {
154837da2899SCharles.Forsyth while (*--s == '0')
154937da2899SCharles.Forsyth ;
155037da2899SCharles.Forsyth s++;
155137da2899SCharles.Forsyth goto ret1;
155237da2899SCharles.Forsyth }
155337da2899SCharles.Forsyth break;
155437da2899SCharles.Forsyth }
155537da2899SCharles.Forsyth }
155637da2899SCharles.Forsyth fast_failed:
155737da2899SCharles.Forsyth s = s0;
155837da2899SCharles.Forsyth d = d2;
155937da2899SCharles.Forsyth k = k0;
156037da2899SCharles.Forsyth ilim = ilim0;
156137da2899SCharles.Forsyth }
156237da2899SCharles.Forsyth
156337da2899SCharles.Forsyth /* Do we have a "small" integer? */
156437da2899SCharles.Forsyth
156537da2899SCharles.Forsyth if (be >= 0 && k <= Int_max) {
156637da2899SCharles.Forsyth /* Yes. */
156737da2899SCharles.Forsyth ds = tens[k];
156837da2899SCharles.Forsyth if (ndigits < 0 && ilim <= 0) {
156937da2899SCharles.Forsyth S = mhi = 0;
157037da2899SCharles.Forsyth if (ilim < 0 || d <= 5 * ds)
157137da2899SCharles.Forsyth goto no_digits;
157237da2899SCharles.Forsyth goto one_digit;
157337da2899SCharles.Forsyth }
157437da2899SCharles.Forsyth for (i = 1; ; i++) {
157537da2899SCharles.Forsyth L = d / ds;
157637da2899SCharles.Forsyth d -= L * ds;
157737da2899SCharles.Forsyth *s++ = '0' + (int)L;
157837da2899SCharles.Forsyth if (i == ilim) {
157937da2899SCharles.Forsyth d += d;
158037da2899SCharles.Forsyth if (d > ds || d == ds && L & 1) {
158137da2899SCharles.Forsyth bump_up:
158237da2899SCharles.Forsyth while (*--s == '9')
158337da2899SCharles.Forsyth if (s == s0) {
158437da2899SCharles.Forsyth k++;
158537da2899SCharles.Forsyth *s = '0';
158637da2899SCharles.Forsyth break;
158737da2899SCharles.Forsyth }
158837da2899SCharles.Forsyth ++ * s++;
158937da2899SCharles.Forsyth }
159037da2899SCharles.Forsyth break;
159137da2899SCharles.Forsyth }
159237da2899SCharles.Forsyth if (!(d *= 10.))
159337da2899SCharles.Forsyth break;
159437da2899SCharles.Forsyth }
159537da2899SCharles.Forsyth goto ret1;
159637da2899SCharles.Forsyth }
159737da2899SCharles.Forsyth
159837da2899SCharles.Forsyth m2 = b2;
159937da2899SCharles.Forsyth m5 = b5;
160037da2899SCharles.Forsyth mhi = mlo = 0;
160137da2899SCharles.Forsyth if (leftright) {
160237da2899SCharles.Forsyth if (mode < 2) {
160337da2899SCharles.Forsyth i =
160437da2899SCharles.Forsyth #ifndef Sudden_Underflow
160537da2899SCharles.Forsyth denorm ? be + (Bias + (P - 1) - 1 + 1) :
160637da2899SCharles.Forsyth #endif
160737da2899SCharles.Forsyth 1 + P - bbits;
160837da2899SCharles.Forsyth } else {
160937da2899SCharles.Forsyth j = ilim - 1;
161037da2899SCharles.Forsyth if (m5 >= j)
161137da2899SCharles.Forsyth m5 -= j;
161237da2899SCharles.Forsyth else {
161337da2899SCharles.Forsyth s5 += j -= m5;
161437da2899SCharles.Forsyth b5 += j;
161537da2899SCharles.Forsyth m5 = 0;
161637da2899SCharles.Forsyth }
161737da2899SCharles.Forsyth if ((i = ilim) < 0) {
161837da2899SCharles.Forsyth m2 -= i;
161937da2899SCharles.Forsyth i = 0;
162037da2899SCharles.Forsyth }
162137da2899SCharles.Forsyth }
162237da2899SCharles.Forsyth b2 += i;
162337da2899SCharles.Forsyth s2 += i;
162437da2899SCharles.Forsyth mhi = i2b(1);
162537da2899SCharles.Forsyth }
162637da2899SCharles.Forsyth if (m2 > 0 && s2 > 0) {
162737da2899SCharles.Forsyth i = m2 < s2 ? m2 : s2;
162837da2899SCharles.Forsyth b2 -= i;
162937da2899SCharles.Forsyth m2 -= i;
163037da2899SCharles.Forsyth s2 -= i;
163137da2899SCharles.Forsyth }
163237da2899SCharles.Forsyth if (b5 > 0) {
163337da2899SCharles.Forsyth if (leftright) {
163437da2899SCharles.Forsyth if (m5 > 0) {
163537da2899SCharles.Forsyth mhi = pow5mult(mhi, m5);
163637da2899SCharles.Forsyth b1 = mult(mhi, b);
163737da2899SCharles.Forsyth Bfree(b);
163837da2899SCharles.Forsyth b = b1;
163937da2899SCharles.Forsyth }
164037da2899SCharles.Forsyth if (j = b5 - m5)
164137da2899SCharles.Forsyth b = pow5mult(b, j);
164237da2899SCharles.Forsyth } else
164337da2899SCharles.Forsyth b = pow5mult(b, b5);
164437da2899SCharles.Forsyth }
164537da2899SCharles.Forsyth S = i2b(1);
164637da2899SCharles.Forsyth if (s5 > 0)
164737da2899SCharles.Forsyth S = pow5mult(S, s5);
164837da2899SCharles.Forsyth
164937da2899SCharles.Forsyth /* Check for special case that d is a normalized power of 2. */
165037da2899SCharles.Forsyth
165137da2899SCharles.Forsyth spec_case = 0;
165237da2899SCharles.Forsyth if (mode < 2) {
165337da2899SCharles.Forsyth if (!word1(d) && !(word0(d) & Bndry_mask)
165437da2899SCharles.Forsyth #ifndef Sudden_Underflow
165537da2899SCharles.Forsyth && word0(d) & Exp_mask
165637da2899SCharles.Forsyth #endif
165737da2899SCharles.Forsyth ) {
165837da2899SCharles.Forsyth /* The special case */
165937da2899SCharles.Forsyth b2 += Log2P;
166037da2899SCharles.Forsyth s2 += Log2P;
166137da2899SCharles.Forsyth spec_case = 1;
166237da2899SCharles.Forsyth }
166337da2899SCharles.Forsyth }
166437da2899SCharles.Forsyth
166537da2899SCharles.Forsyth /* Arrange for convenient computation of quotients:
166637da2899SCharles.Forsyth * shift left if necessary so divisor has 4 leading 0 bits.
166737da2899SCharles.Forsyth *
166837da2899SCharles.Forsyth * Perhaps we should just compute leading 28 bits of S once
166937da2899SCharles.Forsyth * and for all and pass them and a shift to quorem, so it
167037da2899SCharles.Forsyth * can do shifts and ors to compute the numerator for q.
167137da2899SCharles.Forsyth */
167237da2899SCharles.Forsyth if (i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f)
167337da2899SCharles.Forsyth i = 32 - i;
167437da2899SCharles.Forsyth if (i > 4) {
167537da2899SCharles.Forsyth i -= 4;
167637da2899SCharles.Forsyth b2 += i;
167737da2899SCharles.Forsyth m2 += i;
167837da2899SCharles.Forsyth s2 += i;
167937da2899SCharles.Forsyth } else if (i < 4) {
168037da2899SCharles.Forsyth i += 28;
168137da2899SCharles.Forsyth b2 += i;
168237da2899SCharles.Forsyth m2 += i;
168337da2899SCharles.Forsyth s2 += i;
168437da2899SCharles.Forsyth }
168537da2899SCharles.Forsyth if (b2 > 0)
168637da2899SCharles.Forsyth b = lshift(b, b2);
168737da2899SCharles.Forsyth if (s2 > 0)
168837da2899SCharles.Forsyth S = lshift(S, s2);
168937da2899SCharles.Forsyth if (k_check) {
169037da2899SCharles.Forsyth if (cmp(b, S) < 0) {
169137da2899SCharles.Forsyth k--;
169237da2899SCharles.Forsyth b = multadd(b, 10, 0); /* we botched the k estimate */
169337da2899SCharles.Forsyth if (leftright)
169437da2899SCharles.Forsyth mhi = multadd(mhi, 10, 0);
169537da2899SCharles.Forsyth ilim = ilim1;
169637da2899SCharles.Forsyth }
169737da2899SCharles.Forsyth }
169837da2899SCharles.Forsyth if (ilim <= 0 && mode > 2) {
169937da2899SCharles.Forsyth if (ilim < 0 || cmp(b, S = multadd(S, 5, 0)) <= 0) {
170037da2899SCharles.Forsyth /* no digits, fcvt style */
170137da2899SCharles.Forsyth no_digits:
170237da2899SCharles.Forsyth k = -1 - ndigits;
170337da2899SCharles.Forsyth goto ret;
170437da2899SCharles.Forsyth }
170537da2899SCharles.Forsyth one_digit:
170637da2899SCharles.Forsyth *s++ = '1';
170737da2899SCharles.Forsyth k++;
170837da2899SCharles.Forsyth goto ret;
170937da2899SCharles.Forsyth }
171037da2899SCharles.Forsyth if (leftright) {
171137da2899SCharles.Forsyth if (m2 > 0)
171237da2899SCharles.Forsyth mhi = lshift(mhi, m2);
171337da2899SCharles.Forsyth
171437da2899SCharles.Forsyth /* Compute mlo -- check for special case
171537da2899SCharles.Forsyth * that d is a normalized power of 2.
171637da2899SCharles.Forsyth */
171737da2899SCharles.Forsyth
171837da2899SCharles.Forsyth mlo = mhi;
171937da2899SCharles.Forsyth if (spec_case) {
172037da2899SCharles.Forsyth mhi = Balloc(mhi->k);
172137da2899SCharles.Forsyth Bcopy(mhi, mlo);
172237da2899SCharles.Forsyth mhi = lshift(mhi, Log2P);
172337da2899SCharles.Forsyth }
172437da2899SCharles.Forsyth
172537da2899SCharles.Forsyth for (i = 1; ; i++) {
172637da2899SCharles.Forsyth dig = quorem(b, S) + '0';
172737da2899SCharles.Forsyth /* Do we yet have the shortest decimal string
172837da2899SCharles.Forsyth * that will round to d?
172937da2899SCharles.Forsyth */
173037da2899SCharles.Forsyth j = cmp(b, mlo);
173137da2899SCharles.Forsyth delta = diff(S, mhi);
173237da2899SCharles.Forsyth j1 = delta->sign ? 1 : cmp(b, delta);
173337da2899SCharles.Forsyth Bfree(delta);
173437da2899SCharles.Forsyth if (j1 == 0 && !mode && !(word1(d) & 1)) {
173537da2899SCharles.Forsyth if (dig == '9')
173637da2899SCharles.Forsyth goto round_9_up;
173737da2899SCharles.Forsyth if (j > 0)
173837da2899SCharles.Forsyth dig++;
173937da2899SCharles.Forsyth *s++ = dig;
174037da2899SCharles.Forsyth goto ret;
174137da2899SCharles.Forsyth }
174237da2899SCharles.Forsyth if (j < 0 || j == 0 && !mode
174337da2899SCharles.Forsyth && !(word1(d) & 1)
174437da2899SCharles.Forsyth ) {
174537da2899SCharles.Forsyth if (j1 > 0) {
174637da2899SCharles.Forsyth b = lshift(b, 1);
174737da2899SCharles.Forsyth j1 = cmp(b, S);
174837da2899SCharles.Forsyth if ((j1 > 0 || j1 == 0 && dig & 1)
174937da2899SCharles.Forsyth && dig++ == '9')
175037da2899SCharles.Forsyth goto round_9_up;
175137da2899SCharles.Forsyth }
175237da2899SCharles.Forsyth *s++ = dig;
175337da2899SCharles.Forsyth goto ret;
175437da2899SCharles.Forsyth }
175537da2899SCharles.Forsyth if (j1 > 0) {
175637da2899SCharles.Forsyth if (dig == '9') { /* possible if i == 1 */
175737da2899SCharles.Forsyth round_9_up:
175837da2899SCharles.Forsyth *s++ = '9';
175937da2899SCharles.Forsyth goto roundoff;
176037da2899SCharles.Forsyth }
176137da2899SCharles.Forsyth *s++ = dig + 1;
176237da2899SCharles.Forsyth goto ret;
176337da2899SCharles.Forsyth }
176437da2899SCharles.Forsyth *s++ = dig;
176537da2899SCharles.Forsyth if (i == ilim)
176637da2899SCharles.Forsyth break;
176737da2899SCharles.Forsyth b = multadd(b, 10, 0);
176837da2899SCharles.Forsyth if (mlo == mhi)
176937da2899SCharles.Forsyth mlo = mhi = multadd(mhi, 10, 0);
177037da2899SCharles.Forsyth else {
177137da2899SCharles.Forsyth mlo = multadd(mlo, 10, 0);
177237da2899SCharles.Forsyth mhi = multadd(mhi, 10, 0);
177337da2899SCharles.Forsyth }
177437da2899SCharles.Forsyth }
177537da2899SCharles.Forsyth } else
177637da2899SCharles.Forsyth for (i = 1; ; i++) {
177737da2899SCharles.Forsyth *s++ = dig = quorem(b, S) + '0';
177837da2899SCharles.Forsyth if (i >= ilim)
177937da2899SCharles.Forsyth break;
178037da2899SCharles.Forsyth b = multadd(b, 10, 0);
178137da2899SCharles.Forsyth }
178237da2899SCharles.Forsyth
178337da2899SCharles.Forsyth /* Round off last digit */
178437da2899SCharles.Forsyth
178537da2899SCharles.Forsyth b = lshift(b, 1);
178637da2899SCharles.Forsyth j = cmp(b, S);
178737da2899SCharles.Forsyth if (j > 0 || j == 0 && dig & 1) {
178837da2899SCharles.Forsyth roundoff:
178937da2899SCharles.Forsyth while (*--s == '9')
179037da2899SCharles.Forsyth if (s == s0) {
179137da2899SCharles.Forsyth k++;
179237da2899SCharles.Forsyth *s++ = '1';
179337da2899SCharles.Forsyth goto ret;
179437da2899SCharles.Forsyth }
179537da2899SCharles.Forsyth ++ * s++;
179637da2899SCharles.Forsyth } else {
179737da2899SCharles.Forsyth while (*--s == '0')
179837da2899SCharles.Forsyth ;
179937da2899SCharles.Forsyth s++;
180037da2899SCharles.Forsyth }
180137da2899SCharles.Forsyth ret:
180237da2899SCharles.Forsyth Bfree(S);
180337da2899SCharles.Forsyth if (mhi) {
180437da2899SCharles.Forsyth if (mlo && mlo != mhi)
180537da2899SCharles.Forsyth Bfree(mlo);
180637da2899SCharles.Forsyth Bfree(mhi);
180737da2899SCharles.Forsyth }
180837da2899SCharles.Forsyth ret1:
180937da2899SCharles.Forsyth Bfree(b);
181037da2899SCharles.Forsyth *s = 0;
181137da2899SCharles.Forsyth *decpt = k + 1;
181237da2899SCharles.Forsyth if (rve)
181337da2899SCharles.Forsyth *rve = s;
181437da2899SCharles.Forsyth return s0;
181537da2899SCharles.Forsyth }
181637da2899SCharles.Forsyth
1817