1 /* derived from /netlib/fp/dtoa.c assuming IEEE, Standard C */ 2 /* kudos to dmg@bell-labs.com, gripes to ehg@bell-labs.com */ 3 #include "lib9.h" 4 #define ACQUIRE_DTOA_LOCK(n) /*nothing*/ 5 #define FREE_DTOA_LOCK(n) /*nothing*/ 6 7 /* let's provide reasonable defaults for usual implementation of IEEE f.p. */ 8 #ifndef DBL_DIG 9 #define DBL_DIG 15 10 #endif 11 #ifndef DBL_MAX_10_EXP 12 #define DBL_MAX_10_EXP 308 13 #endif 14 #ifndef DBL_MAX_EXP 15 #define DBL_MAX_EXP 1024 16 #endif 17 #ifndef FLT_RADIX 18 #define FLT_RADIX 2 19 #endif 20 #ifndef FLT_ROUNDS 21 #define FLT_ROUNDS 1 22 #endif 23 #ifndef Storeinc 24 #define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff) 25 #endif 26 27 #define Sign_Extend(a,b) if (b < 0) a |= 0xffff0000; 28 29 #ifdef USE_FPdbleword 30 #define word0(x) ((FPdbleword*)&x)->hi 31 #define word1(x) ((FPdbleword*)&x)->lo 32 #else 33 #ifdef __LITTLE_ENDIAN 34 #define word0(x) ((unsigned long *)&x)[1] 35 #define word1(x) ((unsigned long *)&x)[0] 36 #else 37 #define word0(x) ((unsigned long *)&x)[0] 38 #define word1(x) ((unsigned long *)&x)[1] 39 #endif 40 #endif 41 42 /* #define P DBL_MANT_DIG */ 43 /* Ten_pmax = floor(P*log(2)/log(5)) */ 44 /* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */ 45 /* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */ 46 /* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */ 47 48 #define Exp_shift 20 49 #define Exp_shift1 20 50 #define Exp_msk1 0x100000 51 #define Exp_msk11 0x100000 52 #define Exp_mask 0x7ff00000 53 #define P 53 54 #define Bias 1023 55 #define Emin (-1022) 56 #define Exp_1 0x3ff00000 57 #define Exp_11 0x3ff00000 58 #define Ebits 11 59 #define Frac_mask 0xfffff 60 #define Frac_mask1 0xfffff 61 #define Ten_pmax 22 62 #define Bletch 0x10 63 #define Bndry_mask 0xfffff 64 #define Bndry_mask1 0xfffff 65 #define LSB 1 66 #define Sign_bit 0x80000000 67 #define Log2P 1 68 #define Tiny0 0 69 #define Tiny1 1 70 #define Quick_max 14 71 #define Int_max 14 72 #define Infinite(x) (word0(x) == 0x7ff00000) /* sufficient test for here */ 73 #define Avoid_Underflow 74 75 #define rounded_product(a,b) a *= b 76 #define rounded_quotient(a,b) a /= b 77 78 #define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1)) 79 #define Big1 0xffffffff 80 81 #define Kmax 15 82 83 struct 84 Bigint { 85 struct Bigint *next; 86 int k, maxwds, sign, wds; 87 unsigned long x[1]; 88 }; 89 90 typedef struct Bigint Bigint; 91 92 static Bigint *freelist[Kmax+1]; 93 94 static Bigint * 95 Balloc(int k) 96 { 97 int x; 98 Bigint * rv; 99 100 ACQUIRE_DTOA_LOCK(0); 101 if (rv = freelist[k]) { 102 freelist[k] = rv->next; 103 } else { 104 x = 1 << k; 105 rv = (Bigint * )malloc(sizeof(Bigint) + (x - 1) * sizeof(unsigned long)); 106 if(rv == nil) 107 return nil; 108 rv->k = k; 109 rv->maxwds = x; 110 } 111 FREE_DTOA_LOCK(0); 112 rv->sign = rv->wds = 0; 113 return rv; 114 } 115 116 static void 117 Bfree(Bigint *v) 118 { 119 if (v) { 120 ACQUIRE_DTOA_LOCK(0); 121 v->next = freelist[v->k]; 122 freelist[v->k] = v; 123 FREE_DTOA_LOCK(0); 124 } 125 } 126 127 #define Bcopy(x,y) memcpy((char *)&x->sign, (char *)&y->sign, \ 128 y->wds*sizeof(long) + 2*sizeof(int)) 129 130 static Bigint * 131 multadd(Bigint *b, int m, int a) /* multiply by m and add a */ 132 { 133 int i, wds; 134 unsigned long * x, y; 135 unsigned long xi, z; 136 Bigint * b1; 137 138 wds = b->wds; 139 x = b->x; 140 i = 0; 141 do { 142 xi = *x; 143 y = (xi & 0xffff) * m + a; 144 z = (xi >> 16) * m + (y >> 16); 145 a = (int)(z >> 16); 146 *x++ = (z << 16) + (y & 0xffff); 147 } while (++i < wds); 148 if (a) { 149 if (wds >= b->maxwds) { 150 b1 = Balloc(b->k + 1); 151 Bcopy(b1, b); 152 Bfree(b); 153 b = b1; 154 } 155 b->x[wds++] = a; 156 b->wds = wds; 157 } 158 return b; 159 } 160 161 static Bigint * 162 s2b(const char *s, int nd0, int nd, unsigned long y9) 163 { 164 Bigint * b; 165 int i, k; 166 long x, y; 167 168 x = (nd + 8) / 9; 169 for (k = 0, y = 1; x > y; y <<= 1, k++) 170 ; 171 b = Balloc(k); 172 b->x[0] = y9; 173 b->wds = 1; 174 175 i = 9; 176 if (9 < nd0) { 177 s += 9; 178 do 179 b = multadd(b, 10, *s++ - '0'); 180 while (++i < nd0); 181 s++; 182 } else 183 s += 10; 184 for (; i < nd; i++) 185 b = multadd(b, 10, *s++ - '0'); 186 return b; 187 } 188 189 static int 190 hi0bits(register unsigned long x) 191 { 192 register int k = 0; 193 194 if (!(x & 0xffff0000)) { 195 k = 16; 196 x <<= 16; 197 } 198 if (!(x & 0xff000000)) { 199 k += 8; 200 x <<= 8; 201 } 202 if (!(x & 0xf0000000)) { 203 k += 4; 204 x <<= 4; 205 } 206 if (!(x & 0xc0000000)) { 207 k += 2; 208 x <<= 2; 209 } 210 if (!(x & 0x80000000)) { 211 k++; 212 if (!(x & 0x40000000)) 213 return 32; 214 } 215 return k; 216 } 217 218 static int 219 lo0bits(unsigned long *y) 220 { 221 register int k; 222 register unsigned long x = *y; 223 224 if (x & 7) { 225 if (x & 1) 226 return 0; 227 if (x & 2) { 228 *y = x >> 1; 229 return 1; 230 } 231 *y = x >> 2; 232 return 2; 233 } 234 k = 0; 235 if (!(x & 0xffff)) { 236 k = 16; 237 x >>= 16; 238 } 239 if (!(x & 0xff)) { 240 k += 8; 241 x >>= 8; 242 } 243 if (!(x & 0xf)) { 244 k += 4; 245 x >>= 4; 246 } 247 if (!(x & 0x3)) { 248 k += 2; 249 x >>= 2; 250 } 251 if (!(x & 1)) { 252 k++; 253 x >>= 1; 254 if (!x & 1) 255 return 32; 256 } 257 *y = x; 258 return k; 259 } 260 261 static Bigint * 262 i2b(int i) 263 { 264 Bigint * b; 265 266 b = Balloc(1); 267 b->x[0] = i; 268 b->wds = 1; 269 return b; 270 } 271 272 static Bigint * 273 mult(Bigint *a, Bigint *b) 274 { 275 Bigint * c; 276 int k, wa, wb, wc; 277 unsigned long carry, y, z; 278 unsigned long * x, *xa, *xae, *xb, *xbe, *xc, *xc0; 279 unsigned long z2; 280 281 if (a->wds < b->wds) { 282 c = a; 283 a = b; 284 b = c; 285 } 286 k = a->k; 287 wa = a->wds; 288 wb = b->wds; 289 wc = wa + wb; 290 if (wc > a->maxwds) 291 k++; 292 c = Balloc(k); 293 for (x = c->x, xa = x + wc; x < xa; x++) 294 *x = 0; 295 xa = a->x; 296 xae = xa + wa; 297 xb = b->x; 298 xbe = xb + wb; 299 xc0 = c->x; 300 for (; xb < xbe; xb++, xc0++) { 301 if (y = *xb & 0xffff) { 302 x = xa; 303 xc = xc0; 304 carry = 0; 305 do { 306 z = (*x & 0xffff) * y + (*xc & 0xffff) + carry; 307 carry = z >> 16; 308 z2 = (*x++ >> 16) * y + (*xc >> 16) + carry; 309 carry = z2 >> 16; 310 Storeinc(xc, z2, z); 311 } while (x < xae); 312 *xc = carry; 313 } 314 if (y = *xb >> 16) { 315 x = xa; 316 xc = xc0; 317 carry = 0; 318 z2 = *xc; 319 do { 320 z = (*x & 0xffff) * y + (*xc >> 16) + carry; 321 carry = z >> 16; 322 Storeinc(xc, z, z2); 323 z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry; 324 carry = z2 >> 16; 325 } while (x < xae); 326 *xc = z2; 327 } 328 } 329 for (xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc) 330 ; 331 c->wds = wc; 332 return c; 333 } 334 335 static Bigint *p5s; 336 337 static Bigint * 338 pow5mult(Bigint *b, int k) 339 { 340 Bigint * b1, *p5, *p51; 341 int i; 342 static int p05[3] = { 343 5, 25, 125 }; 344 345 if (i = k & 3) 346 b = multadd(b, p05[i-1], 0); 347 348 if (!(k >>= 2)) 349 return b; 350 if (!(p5 = p5s)) { 351 /* first time */ 352 ACQUIRE_DTOA_LOCK(1); 353 if (!(p5 = p5s)) { 354 p5 = p5s = i2b(625); 355 p5->next = 0; 356 } 357 FREE_DTOA_LOCK(1); 358 } 359 for (; ; ) { 360 if (k & 1) { 361 b1 = mult(b, p5); 362 Bfree(b); 363 b = b1; 364 } 365 if (!(k >>= 1)) 366 break; 367 if (!(p51 = p5->next)) { 368 ACQUIRE_DTOA_LOCK(1); 369 if (!(p51 = p5->next)) { 370 p51 = p5->next = mult(p5, p5); 371 p51->next = 0; 372 } 373 FREE_DTOA_LOCK(1); 374 } 375 p5 = p51; 376 } 377 return b; 378 } 379 380 static Bigint * 381 lshift(Bigint *b, int k) 382 { 383 int i, k1, n, n1; 384 Bigint * b1; 385 unsigned long * x, *x1, *xe, z; 386 387 n = k >> 5; 388 k1 = b->k; 389 n1 = n + b->wds + 1; 390 for (i = b->maxwds; n1 > i; i <<= 1) 391 k1++; 392 b1 = Balloc(k1); 393 x1 = b1->x; 394 for (i = 0; i < n; i++) 395 *x1++ = 0; 396 x = b->x; 397 xe = x + b->wds; 398 if (k &= 0x1f) { 399 k1 = 32 - k; 400 z = 0; 401 do { 402 *x1++ = *x << k | z; 403 z = *x++ >> k1; 404 } while (x < xe); 405 if (*x1 = z) 406 ++n1; 407 } else 408 do 409 *x1++ = *x++; 410 while (x < xe); 411 b1->wds = n1 - 1; 412 Bfree(b); 413 return b1; 414 } 415 416 static int 417 cmp(Bigint *a, Bigint *b) 418 { 419 unsigned long * xa, *xa0, *xb, *xb0; 420 int i, j; 421 422 i = a->wds; 423 j = b->wds; 424 if (i -= j) 425 return i; 426 xa0 = a->x; 427 xa = xa0 + j; 428 xb0 = b->x; 429 xb = xb0 + j; 430 for (; ; ) { 431 if (*--xa != *--xb) 432 return * xa < *xb ? -1 : 1; 433 if (xa <= xa0) 434 break; 435 } 436 return 0; 437 } 438 439 static Bigint * 440 diff(Bigint *a, Bigint *b) 441 { 442 Bigint * c; 443 int i, wa, wb; 444 long borrow, y; /* We need signed shifts here. */ 445 unsigned long * xa, *xae, *xb, *xbe, *xc; 446 long z; 447 448 i = cmp(a, b); 449 if (!i) { 450 c = Balloc(0); 451 c->wds = 1; 452 c->x[0] = 0; 453 return c; 454 } 455 if (i < 0) { 456 c = a; 457 a = b; 458 b = c; 459 i = 1; 460 } else 461 i = 0; 462 c = Balloc(a->k); 463 c->sign = i; 464 wa = a->wds; 465 xa = a->x; 466 xae = xa + wa; 467 wb = b->wds; 468 xb = b->x; 469 xbe = xb + wb; 470 xc = c->x; 471 borrow = 0; 472 do { 473 y = (*xa & 0xffff) - (*xb & 0xffff) + borrow; 474 borrow = y >> 16; 475 Sign_Extend(borrow, y); 476 z = (*xa++ >> 16) - (*xb++ >> 16) + borrow; 477 borrow = z >> 16; 478 Sign_Extend(borrow, z); 479 Storeinc(xc, z, y); 480 } while (xb < xbe); 481 while (xa < xae) { 482 y = (*xa & 0xffff) + borrow; 483 borrow = y >> 16; 484 Sign_Extend(borrow, y); 485 z = (*xa++ >> 16) + borrow; 486 borrow = z >> 16; 487 Sign_Extend(borrow, z); 488 Storeinc(xc, z, y); 489 } 490 while (!*--xc) 491 wa--; 492 c->wds = wa; 493 return c; 494 } 495 496 static double 497 ulp(double x) 498 { 499 register long L; 500 double a; 501 502 L = (word0(x) & Exp_mask) - (P - 1) * Exp_msk1; 503 #ifndef Sudden_Underflow 504 if (L > 0) { 505 #endif 506 word0(a) = L; 507 word1(a) = 0; 508 #ifndef Sudden_Underflow 509 } else { 510 L = -L >> Exp_shift; 511 if (L < Exp_shift) { 512 word0(a) = 0x80000 >> L; 513 word1(a) = 0; 514 } else { 515 word0(a) = 0; 516 L -= Exp_shift; 517 word1(a) = L >= 31 ? 1 : 1 << 31 - L; 518 } 519 } 520 #endif 521 return a; 522 } 523 524 static double 525 b2d(Bigint *a, int *e) 526 { 527 unsigned long * xa, *xa0, w, y, z; 528 int k; 529 double d; 530 #define d0 word0(d) 531 #define d1 word1(d) 532 533 xa0 = a->x; 534 xa = xa0 + a->wds; 535 y = *--xa; 536 k = hi0bits(y); 537 *e = 32 - k; 538 if (k < Ebits) { 539 d0 = Exp_1 | y >> Ebits - k; 540 w = xa > xa0 ? *--xa : 0; 541 d1 = y << (32 - Ebits) + k | w >> Ebits - k; 542 goto ret_d; 543 } 544 z = xa > xa0 ? *--xa : 0; 545 if (k -= Ebits) { 546 d0 = Exp_1 | y << k | z >> 32 - k; 547 y = xa > xa0 ? *--xa : 0; 548 d1 = z << k | y >> 32 - k; 549 } else { 550 d0 = Exp_1 | y; 551 d1 = z; 552 } 553 ret_d: 554 #undef d0 555 #undef d1 556 return d; 557 } 558 559 static Bigint * 560 d2b(double d, int *e, int *bits) 561 { 562 Bigint * b; 563 int de, i, k; 564 unsigned long * x, y, z; 565 #define d0 word0(d) 566 #define d1 word1(d) 567 568 b = Balloc(1); 569 x = b->x; 570 571 z = d0 & Frac_mask; 572 d0 &= 0x7fffffff; /* clear sign bit, which we ignore */ 573 #ifdef Sudden_Underflow 574 de = (int)(d0 >> Exp_shift); 575 z |= Exp_msk11; 576 #else 577 if (de = (int)(d0 >> Exp_shift)) 578 z |= Exp_msk1; 579 #endif 580 if (y = d1) { 581 if (k = lo0bits(&y)) { 582 x[0] = y | z << 32 - k; 583 z >>= k; 584 } else 585 x[0] = y; 586 i = b->wds = (x[1] = z) ? 2 : 1; 587 } else { 588 k = lo0bits(&z); 589 x[0] = z; 590 i = b->wds = 1; 591 k += 32; 592 } 593 #ifndef Sudden_Underflow 594 if (de) { 595 #endif 596 *e = de - Bias - (P - 1) + k; 597 *bits = P - k; 598 #ifndef Sudden_Underflow 599 } else { 600 *e = de - Bias - (P - 1) + 1 + k; 601 *bits = 32 * i - hi0bits(x[i-1]); 602 } 603 #endif 604 return b; 605 } 606 607 #undef d0 608 #undef d1 609 610 static double 611 ratio(Bigint *a, Bigint *b) 612 { 613 double da, db; 614 int k, ka, kb; 615 616 da = b2d(a, &ka); 617 db = b2d(b, &kb); 618 k = ka - kb + 32 * (a->wds - b->wds); 619 if (k > 0) 620 word0(da) += k * Exp_msk1; 621 else { 622 k = -k; 623 word0(db) += k * Exp_msk1; 624 } 625 return da / db; 626 } 627 628 static const double 629 tens[] = { 630 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9, 631 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 632 1e20, 1e21, 1e22 633 }; 634 635 static const double 636 bigtens[] = { 637 1e16, 1e32, 1e64, 1e128, 1e256 }; 638 639 static const double tinytens[] = { 640 1e-16, 1e-32, 1e-64, 1e-128, 641 9007199254740992.e-256 642 }; 643 644 /* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */ 645 /* flag unnecessarily. It leads to a song and dance at the end of strtod. */ 646 #define Scale_Bit 0x10 647 #define n_bigtens 5 648 649 #define NAN_WORD0 0x7ff80000 650 651 #define NAN_WORD1 0 652 653 static int 654 match(const char **sp, char *t) 655 { 656 int c, d; 657 const char * s = *sp; 658 659 while (d = *t++) { 660 if ((c = *++s) >= 'A' && c <= 'Z') 661 c += 'a' - 'A'; 662 if (c != d) 663 return 0; 664 } 665 *sp = s + 1; 666 return 1; 667 } 668 669 double 670 strtod(const char *s00, char **se) 671 { 672 int scale; 673 int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign, 674 e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign; 675 const char * s, *s0, *s1; 676 double aadj, aadj1, adj, rv, rv0; 677 long L; 678 unsigned long y, z; 679 Bigint * bb, *bb1, *bd, *bd0, *bs, *delta; 680 sign = nz0 = nz = 0; 681 rv = 0.; 682 for (s = s00; ; s++) 683 switch (*s) { 684 case '-': 685 sign = 1; 686 /* no break */ 687 case '+': 688 if (*++s) 689 goto break2; 690 /* no break */ 691 case 0: 692 s = s00; 693 goto ret; 694 case '\t': 695 case '\n': 696 case '\v': 697 case '\f': 698 case '\r': 699 case ' ': 700 continue; 701 default: 702 goto break2; 703 } 704 break2: 705 if (*s == '0') { 706 nz0 = 1; 707 while (*++s == '0') 708 ; 709 if (!*s) 710 goto ret; 711 } 712 s0 = s; 713 y = z = 0; 714 for (nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++) 715 if (nd < 9) 716 y = 10 * y + c - '0'; 717 else if (nd < 16) 718 z = 10 * z + c - '0'; 719 nd0 = nd; 720 if (c == '.') { 721 c = *++s; 722 if (!nd) { 723 for (; c == '0'; c = *++s) 724 nz++; 725 if (c > '0' && c <= '9') { 726 s0 = s; 727 nf += nz; 728 nz = 0; 729 goto have_dig; 730 } 731 goto dig_done; 732 } 733 for (; c >= '0' && c <= '9'; c = *++s) { 734 have_dig: 735 nz++; 736 if (c -= '0') { 737 nf += nz; 738 for (i = 1; i < nz; i++) 739 if (nd++ < 9) 740 y *= 10; 741 else if (nd <= DBL_DIG + 1) 742 z *= 10; 743 if (nd++ < 9) 744 y = 10 * y + c; 745 else if (nd <= DBL_DIG + 1) 746 z = 10 * z + c; 747 nz = 0; 748 } 749 } 750 } 751 dig_done: 752 e = 0; 753 if (c == 'e' || c == 'E') { 754 if (!nd && !nz && !nz0) { 755 s = s00; 756 goto ret; 757 } 758 s00 = s; 759 esign = 0; 760 switch (c = *++s) { 761 case '-': 762 esign = 1; 763 case '+': 764 c = *++s; 765 } 766 if (c >= '0' && c <= '9') { 767 while (c == '0') 768 c = *++s; 769 if (c > '0' && c <= '9') { 770 L = c - '0'; 771 s1 = s; 772 while ((c = *++s) >= '0' && c <= '9') 773 L = 10 * L + c - '0'; 774 if (s - s1 > 8 || L > 19999) 775 /* Avoid confusion from exponents 776 * so large that e might overflow. 777 */ 778 e = 19999; /* safe for 16 bit ints */ 779 else 780 e = (int)L; 781 if (esign) 782 e = -e; 783 } else 784 e = 0; 785 } else 786 s = s00; 787 } 788 if (!nd) { 789 if (!nz && !nz0) { 790 /* Check for Nan and Infinity */ 791 switch (c) { 792 case 'i': 793 case 'I': 794 if (match(&s, "nfinity")) { 795 word0(rv) = 0x7ff00000; 796 word1(rv) = 0; 797 goto ret; 798 } 799 break; 800 case 'n': 801 case 'N': 802 if (match(&s, "an")) { 803 word0(rv) = NAN_WORD0; 804 word1(rv) = NAN_WORD1; 805 goto ret; 806 } 807 } 808 s = s00; 809 } 810 goto ret; 811 } 812 e1 = e -= nf; 813 814 /* Now we have nd0 digits, starting at s0, followed by a 815 * decimal point, followed by nd-nd0 digits. The number we're 816 * after is the integer represented by those digits times 817 * 10**e */ 818 819 if (!nd0) 820 nd0 = nd; 821 k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1; 822 rv = y; 823 if (k > 9) 824 rv = tens[k - 9] * rv + z; 825 bd0 = 0; 826 if (nd <= DBL_DIG 827 && FLT_ROUNDS == 1 828 ) { 829 if (!e) 830 goto ret; 831 if (e > 0) { 832 if (e <= Ten_pmax) { 833 /* rv = */ rounded_product(rv, tens[e]); 834 goto ret; 835 } 836 i = DBL_DIG - nd; 837 if (e <= Ten_pmax + i) { 838 /* A fancier test would sometimes let us do 839 * this for larger i values. 840 */ 841 e -= i; 842 rv *= tens[i]; 843 /* rv = */ rounded_product(rv, tens[e]); 844 goto ret; 845 } 846 } else if (e >= -Ten_pmax) { 847 /* rv = */ rounded_quotient(rv, tens[-e]); 848 goto ret; 849 } 850 } 851 e1 += nd - k; 852 853 scale = 0; 854 855 /* Get starting approximation = rv * 10**e1 */ 856 857 if (e1 > 0) { 858 if (i = e1 & 15) 859 rv *= tens[i]; 860 if (e1 &= ~15) { 861 if (e1 > DBL_MAX_10_EXP) { 862 ovfl: 863 /* Can't trust HUGE_VAL */ 864 word0(rv) = Exp_mask; 865 word1(rv) = 0; 866 if (bd0) 867 goto retfree; 868 goto ret; 869 } 870 if (e1 >>= 4) { 871 for (j = 0; e1 > 1; j++, e1 >>= 1) 872 if (e1 & 1) 873 rv *= bigtens[j]; 874 /* The last multiplication could overflow. */ 875 word0(rv) -= P * Exp_msk1; 876 rv *= bigtens[j]; 877 if ((z = word0(rv) & Exp_mask) 878 > Exp_msk1 * (DBL_MAX_EXP + Bias - P)) 879 goto ovfl; 880 if (z > Exp_msk1 * (DBL_MAX_EXP + Bias - 1 - P)) { 881 /* set to largest number */ 882 /* (Can't trust DBL_MAX) */ 883 word0(rv) = Big0; 884 word1(rv) = Big1; 885 } else 886 word0(rv) += P * Exp_msk1; 887 } 888 889 } 890 } else if (e1 < 0) { 891 e1 = -e1; 892 if (i = e1 & 15) 893 rv /= tens[i]; 894 if (e1 &= ~15) { 895 e1 >>= 4; 896 if (e1 >= 1 << n_bigtens) 897 goto undfl; 898 if (e1 & Scale_Bit) 899 scale = P; 900 for (j = 0; e1 > 0; j++, e1 >>= 1) 901 if (e1 & 1) 902 rv *= tinytens[j]; 903 if (!rv) { 904 undfl: 905 rv = 0.; 906 if (bd0) 907 goto retfree; 908 goto ret; 909 } 910 } 911 } 912 913 /* Now the hard part -- adjusting rv to the correct value.*/ 914 915 /* Put digits into bd: true value = bd * 10^e */ 916 917 bd0 = s2b(s0, nd0, nd, y); 918 919 for (; ; ) { 920 bd = Balloc(bd0->k); 921 Bcopy(bd, bd0); 922 bb = d2b(rv, &bbe, &bbbits); /* rv = bb * 2^bbe */ 923 bs = i2b(1); 924 925 if (e >= 0) { 926 bb2 = bb5 = 0; 927 bd2 = bd5 = e; 928 } else { 929 bb2 = bb5 = -e; 930 bd2 = bd5 = 0; 931 } 932 if (bbe >= 0) 933 bb2 += bbe; 934 else 935 bd2 -= bbe; 936 bs2 = bb2; 937 #ifdef Sudden_Underflow 938 j = P + 1 - bbbits; 939 #else 940 i = bbe + bbbits - 1; /* logb(rv) */ 941 if (i < Emin) /* denormal */ 942 j = bbe + (P - Emin); 943 else 944 j = P + 1 - bbbits; 945 #endif 946 bb2 += j; 947 bd2 += j; 948 bd2 += scale; 949 i = bb2 < bd2 ? bb2 : bd2; 950 if (i > bs2) 951 i = bs2; 952 if (i > 0) { 953 bb2 -= i; 954 bd2 -= i; 955 bs2 -= i; 956 } 957 if (bb5 > 0) { 958 bs = pow5mult(bs, bb5); 959 bb1 = mult(bs, bb); 960 Bfree(bb); 961 bb = bb1; 962 } 963 if (bb2 > 0) 964 bb = lshift(bb, bb2); 965 if (bd5 > 0) 966 bd = pow5mult(bd, bd5); 967 if (bd2 > 0) 968 bd = lshift(bd, bd2); 969 if (bs2 > 0) 970 bs = lshift(bs, bs2); 971 delta = diff(bb, bd); 972 dsign = delta->sign; 973 delta->sign = 0; 974 i = cmp(delta, bs); 975 if (i < 0) { 976 /* Error is less than half an ulp -- check for 977 * special case of mantissa a power of two. 978 */ 979 if (dsign || word1(rv) || word0(rv) & Bndry_mask 980 || (word0(rv) & Exp_mask) <= Exp_msk1 981 ) { 982 if (!delta->x[0] && delta->wds == 1) 983 dsign = 2; 984 break; 985 } 986 delta = lshift(delta, Log2P); 987 if (cmp(delta, bs) > 0) 988 goto drop_down; 989 break; 990 } 991 if (i == 0) { 992 /* exactly half-way between */ 993 if (dsign) { 994 if ((word0(rv) & Bndry_mask1) == Bndry_mask1 995 && word1(rv) == 0xffffffff) { 996 /*boundary case -- increment exponent*/ 997 word0(rv) = (word0(rv) & Exp_mask) 998 + Exp_msk1 999 ; 1000 word1(rv) = 0; 1001 dsign = 0; 1002 break; 1003 } 1004 } else if (!(word0(rv) & Bndry_mask) && !word1(rv)) { 1005 dsign = 2; 1006 drop_down: 1007 /* boundary case -- decrement exponent */ 1008 #ifdef Sudden_Underflow 1009 L = word0(rv) & Exp_mask; 1010 if (L <= Exp_msk1) 1011 goto undfl; 1012 L -= Exp_msk1; 1013 #else 1014 L = (word0(rv) & Exp_mask) - Exp_msk1; 1015 #endif 1016 word0(rv) = L | Bndry_mask1; 1017 word1(rv) = 0xffffffff; 1018 break; 1019 } 1020 if (!(word1(rv) & LSB)) 1021 break; 1022 if (dsign) 1023 rv += ulp(rv); 1024 else { 1025 rv -= ulp(rv); 1026 #ifndef Sudden_Underflow 1027 if (!rv) 1028 goto undfl; 1029 #endif 1030 } 1031 dsign = 1 - dsign; 1032 break; 1033 } 1034 if ((aadj = ratio(delta, bs)) <= 2.) { 1035 if (dsign) 1036 aadj = aadj1 = 1.; 1037 else if (word1(rv) || word0(rv) & Bndry_mask) { 1038 #ifndef Sudden_Underflow 1039 if (word1(rv) == Tiny1 && !word0(rv)) 1040 goto undfl; 1041 #endif 1042 aadj = 1.; 1043 aadj1 = -1.; 1044 } else { 1045 /* special case -- power of FLT_RADIX to be */ 1046 /* rounded down... */ 1047 1048 if (aadj < 2. / FLT_RADIX) 1049 aadj = 1. / FLT_RADIX; 1050 else 1051 aadj *= 0.5; 1052 aadj1 = -aadj; 1053 } 1054 } else { 1055 aadj *= 0.5; 1056 aadj1 = dsign ? aadj : -aadj; 1057 if (FLT_ROUNDS == 0) 1058 aadj1 += 0.5; 1059 } 1060 y = word0(rv) & Exp_mask; 1061 1062 /* Check for overflow */ 1063 1064 if (y == Exp_msk1 * (DBL_MAX_EXP + Bias - 1)) { 1065 rv0 = rv; 1066 word0(rv) -= P * Exp_msk1; 1067 adj = aadj1 * ulp(rv); 1068 rv += adj; 1069 if ((word0(rv) & Exp_mask) >= 1070 Exp_msk1 * (DBL_MAX_EXP + Bias - P)) { 1071 if (word0(rv0) == Big0 && word1(rv0) == Big1) 1072 goto ovfl; 1073 word0(rv) = Big0; 1074 word1(rv) = Big1; 1075 goto cont; 1076 } else 1077 word0(rv) += P * Exp_msk1; 1078 } else { 1079 #ifdef Sudden_Underflow 1080 if ((word0(rv) & Exp_mask) <= P * Exp_msk1) { 1081 rv0 = rv; 1082 word0(rv) += P * Exp_msk1; 1083 adj = aadj1 * ulp(rv); 1084 rv += adj; 1085 if ((word0(rv) & Exp_mask) <= P * Exp_msk1) { 1086 if (word0(rv0) == Tiny0 1087 && word1(rv0) == Tiny1) 1088 goto undfl; 1089 word0(rv) = Tiny0; 1090 word1(rv) = Tiny1; 1091 goto cont; 1092 } else 1093 word0(rv) -= P * Exp_msk1; 1094 } else { 1095 adj = aadj1 * ulp(rv); 1096 rv += adj; 1097 } 1098 #else 1099 /* Compute adj so that the IEEE rounding rules will 1100 * correctly round rv + adj in some half-way cases. 1101 * If rv * ulp(rv) is denormalized (i.e., 1102 * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid 1103 * trouble from bits lost to denormalization; 1104 * example: 1.2e-307 . 1105 */ 1106 if (y <= (P - 1) * Exp_msk1 && aadj >= 1.) { 1107 aadj1 = (double)(int)(aadj + 0.5); 1108 if (!dsign) 1109 aadj1 = -aadj1; 1110 } 1111 adj = aadj1 * ulp(rv); 1112 rv += adj; 1113 #endif 1114 } 1115 z = word0(rv) & Exp_mask; 1116 if (!scale) 1117 if (y == z) { 1118 /* Can we stop now? */ 1119 L = aadj; 1120 aadj -= L; 1121 /* The tolerances below are conservative. */ 1122 if (dsign || word1(rv) || word0(rv) & Bndry_mask) { 1123 if (aadj < .4999999 || aadj > .5000001) 1124 break; 1125 } else if (aadj < .4999999 / FLT_RADIX) 1126 break; 1127 } 1128 cont: 1129 Bfree(bb); 1130 Bfree(bd); 1131 Bfree(bs); 1132 Bfree(delta); 1133 } 1134 if (scale) { 1135 if ((word0(rv) & Exp_mask) <= P * Exp_msk1 1136 && word1(rv) & 1 1137 && dsign != 2) 1138 if (dsign) 1139 rv += ulp(rv); 1140 else 1141 word1(rv) &= ~1; 1142 word0(rv0) = Exp_1 - P * Exp_msk1; 1143 word1(rv0) = 0; 1144 rv *= rv0; 1145 } 1146 retfree: 1147 Bfree(bb); 1148 Bfree(bd); 1149 Bfree(bs); 1150 Bfree(bd0); 1151 Bfree(delta); 1152 ret: 1153 if (se) 1154 *se = (char *)s; 1155 return sign ? -rv : rv; 1156 } 1157 1158 static int 1159 quorem(Bigint *b, Bigint *S) 1160 { 1161 int n; 1162 long borrow, y; 1163 unsigned long carry, q, ys; 1164 unsigned long * bx, *bxe, *sx, *sxe; 1165 long z; 1166 unsigned long si, zs; 1167 1168 n = S->wds; 1169 if (b->wds < n) 1170 return 0; 1171 sx = S->x; 1172 sxe = sx + --n; 1173 bx = b->x; 1174 bxe = bx + n; 1175 q = *bxe / (*sxe + 1); /* ensure q <= true quotient */ 1176 if (q) { 1177 borrow = 0; 1178 carry = 0; 1179 do { 1180 si = *sx++; 1181 ys = (si & 0xffff) * q + carry; 1182 zs = (si >> 16) * q + (ys >> 16); 1183 carry = zs >> 16; 1184 y = (*bx & 0xffff) - (ys & 0xffff) + borrow; 1185 borrow = y >> 16; 1186 Sign_Extend(borrow, y); 1187 z = (*bx >> 16) - (zs & 0xffff) + borrow; 1188 borrow = z >> 16; 1189 Sign_Extend(borrow, z); 1190 Storeinc(bx, z, y); 1191 } while (sx <= sxe); 1192 if (!*bxe) { 1193 bx = b->x; 1194 while (--bxe > bx && !*bxe) 1195 --n; 1196 b->wds = n; 1197 } 1198 } 1199 if (cmp(b, S) >= 0) { 1200 q++; 1201 borrow = 0; 1202 carry = 0; 1203 bx = b->x; 1204 sx = S->x; 1205 do { 1206 si = *sx++; 1207 ys = (si & 0xffff) + carry; 1208 zs = (si >> 16) + (ys >> 16); 1209 carry = zs >> 16; 1210 y = (*bx & 0xffff) - (ys & 0xffff) + borrow; 1211 borrow = y >> 16; 1212 Sign_Extend(borrow, y); 1213 z = (*bx >> 16) - (zs & 0xffff) + borrow; 1214 borrow = z >> 16; 1215 Sign_Extend(borrow, z); 1216 Storeinc(bx, z, y); 1217 } while (sx <= sxe); 1218 bx = b->x; 1219 bxe = bx + n; 1220 if (!*bxe) { 1221 while (--bxe > bx && !*bxe) 1222 --n; 1223 b->wds = n; 1224 } 1225 } 1226 return q; 1227 } 1228 1229 static char * 1230 rv_alloc(int i) 1231 { 1232 int j, k, *r; 1233 1234 j = sizeof(unsigned long); 1235 for (k = 0; 1236 sizeof(Bigint) - sizeof(unsigned long) - sizeof(int) + j <= i; 1237 j <<= 1) 1238 k++; 1239 r = (int * )Balloc(k); 1240 *r = k; 1241 return 1242 (char *)(r + 1); 1243 } 1244 1245 static char * 1246 nrv_alloc(char *s, char **rve, int n) 1247 { 1248 char *rv, *t; 1249 1250 t = rv = rv_alloc(n); 1251 while (*t = *s++) 1252 t++; 1253 if (rve) 1254 *rve = t; 1255 return rv; 1256 } 1257 1258 /* freedtoa(s) must be used to free values s returned by dtoa 1259 * when MULTIPLE_THREADS is #defined. It should be used in all cases, 1260 * but for consistency with earlier versions of dtoa, it is optional 1261 * when MULTIPLE_THREADS is not defined. 1262 */ 1263 1264 void 1265 freedtoa(char *s) 1266 { 1267 Bigint * b = (Bigint * )((int *)s - 1); 1268 b->maxwds = 1 << (b->k = *(int * )b); 1269 Bfree(b); 1270 } 1271 1272 /* dtoa for IEEE arithmetic (dmg): convert double to ASCII string. 1273 * 1274 * Inspired by "How to Print Floating-Point Numbers Accurately" by 1275 * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 92-101]. 1276 * 1277 * Modifications: 1278 * 1. Rather than iterating, we use a simple numeric overestimate 1279 * to determine k = floor(log10(d)). We scale relevant 1280 * quantities using O(log2(k)) rather than O(k) multiplications. 1281 * 2. For some modes > 2 (corresponding to ecvt and fcvt), we don't 1282 * try to generate digits strictly left to right. Instead, we 1283 * compute with fewer bits and propagate the carry if necessary 1284 * when rounding the final digit up. This is often faster. 1285 * 3. Under the assumption that input will be rounded nearest, 1286 * mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22. 1287 * That is, we allow equality in stopping tests when the 1288 * round-nearest rule will give the same floating-point value 1289 * as would satisfaction of the stopping test with strict 1290 * inequality. 1291 * 4. We remove common factors of powers of 2 from relevant 1292 * quantities. 1293 * 5. When converting floating-point integers less than 1e16, 1294 * we use floating-point arithmetic rather than resorting 1295 * to multiple-precision integers. 1296 * 6. When asked to produce fewer than 15 digits, we first try 1297 * to get by with floating-point arithmetic; we resort to 1298 * multiple-precision integer arithmetic only if we cannot 1299 * guarantee that the floating-point calculation has given 1300 * the correctly rounded result. For k requested digits and 1301 * "uniformly" distributed input, the probability is 1302 * something like 10^(k-15) that we must resort to the long 1303 * calculation. 1304 */ 1305 1306 char * 1307 dtoa(double d, int mode, int ndigits, int *decpt, int *sign, char **rve) 1308 { 1309 /* Arguments ndigits, decpt, sign are similar to those 1310 of ecvt and fcvt; trailing zeros are suppressed from 1311 the returned string. If not null, *rve is set to point 1312 to the end of the return value. If d is +-Infinity or NaN, 1313 then *decpt is set to 9999. 1314 1315 mode: 1316 0 ==> shortest string that yields d when read in 1317 and rounded to nearest. 1318 1 ==> like 0, but with Steele & White stopping rule; 1319 e.g. with IEEE P754 arithmetic , mode 0 gives 1320 1e23 whereas mode 1 gives 9.999999999999999e22. 1321 2 ==> max(1,ndigits) significant digits. This gives a 1322 return value similar to that of ecvt, except 1323 that trailing zeros are suppressed. 1324 3 ==> through ndigits past the decimal point. This 1325 gives a return value similar to that from fcvt, 1326 except that trailing zeros are suppressed, and 1327 ndigits can be negative. 1328 4-9 should give the same return values as 2-3, i.e., 1329 4 <= mode <= 9 ==> same return as mode 1330 2 + (mode & 1). These modes are mainly for 1331 debugging; often they run slower but sometimes 1332 faster than modes 2-3. 1333 4,5,8,9 ==> left-to-right digit generation. 1334 6-9 ==> don't try fast floating-point estimate 1335 (if applicable). 1336 1337 Values of mode other than 0-9 are treated as mode 0. 1338 1339 Sufficient space is allocated to the return value 1340 to hold the suppressed trailing zeros. 1341 */ 1342 1343 int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1, 1344 j, j1, k, k0, k_check, leftright, m2, m5, s2, s5, 1345 spec_case, try_quick; 1346 long L; 1347 #ifndef Sudden_Underflow 1348 int denorm; 1349 unsigned long x; 1350 #endif 1351 Bigint * b, *b1, *delta, *mlo, *mhi, *S; 1352 double d2, ds, eps; 1353 char *s, *s0; 1354 1355 if (word0(d) & Sign_bit) { 1356 /* set sign for everything, including 0's and NaNs */ 1357 *sign = 1; 1358 word0(d) &= ~Sign_bit; /* clear sign bit */ 1359 } else 1360 *sign = 0; 1361 1362 if ((word0(d) & Exp_mask) == Exp_mask) { 1363 /* Infinity or NaN */ 1364 *decpt = 9999; 1365 if (!word1(d) && !(word0(d) & 0xfffff)) 1366 return nrv_alloc("Infinity", rve, 8); 1367 return nrv_alloc("NaN", rve, 3); 1368 } 1369 if (!d) { 1370 *decpt = 1; 1371 return nrv_alloc("0", rve, 1); 1372 } 1373 1374 b = d2b(d, &be, &bbits); 1375 #ifdef Sudden_Underflow 1376 i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1)); 1377 #else 1378 if (i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1))) { 1379 #endif 1380 word0(d2) = (word0(d) & Frac_mask1) | Exp_11; 1381 word1(d2) = word1(d); 1382 1383 /* log(x) ~=~ log(1.5) + (x-1.5)/1.5 1384 * log10(x) = log(x) / log(10) 1385 * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10)) 1386 * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2) 1387 * 1388 * This suggests computing an approximation k to log10(d) by 1389 * 1390 * k = (i - Bias)*0.301029995663981 1391 * + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 ); 1392 * 1393 * We want k to be too large rather than too small. 1394 * The error in the first-order Taylor series approximation 1395 * is in our favor, so we just round up the constant enough 1396 * to compensate for any error in the multiplication of 1397 * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077, 1398 * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14, 1399 * adding 1e-13 to the constant term more than suffices. 1400 * Hence we adjust the constant term to 0.1760912590558. 1401 * (We could get a more accurate k by invoking log10, 1402 * but this is probably not worthwhile.) 1403 */ 1404 1405 i -= Bias; 1406 #ifndef Sudden_Underflow 1407 denorm = 0; 1408 } else { 1409 /* d is denormalized */ 1410 1411 i = bbits + be + (Bias + (P - 1) - 1); 1412 x = i > 32 ? word0(d) << 64 - i | word1(d) >> i - 32 1413 : word1(d) << 32 - i; 1414 d2 = x; 1415 word0(d2) -= 31 * Exp_msk1; /* adjust exponent */ 1416 i -= (Bias + (P - 1) - 1) + 1; 1417 denorm = 1; 1418 } 1419 #endif 1420 ds = (d2 - 1.5) * 0.289529654602168 + 0.1760912590558 + i * 0.301029995663981; 1421 k = (int)ds; 1422 if (ds < 0. && ds != k) 1423 k--; /* want k = floor(ds) */ 1424 k_check = 1; 1425 if (k >= 0 && k <= Ten_pmax) { 1426 if (d < tens[k]) 1427 k--; 1428 k_check = 0; 1429 } 1430 j = bbits - i - 1; 1431 if (j >= 0) { 1432 b2 = 0; 1433 s2 = j; 1434 } else { 1435 b2 = -j; 1436 s2 = 0; 1437 } 1438 if (k >= 0) { 1439 b5 = 0; 1440 s5 = k; 1441 s2 += k; 1442 } else { 1443 b2 -= k; 1444 b5 = -k; 1445 s5 = 0; 1446 } 1447 if (mode < 0 || mode > 9) 1448 mode = 0; 1449 try_quick = 1; 1450 if (mode > 5) { 1451 mode -= 4; 1452 try_quick = 0; 1453 } 1454 leftright = 1; 1455 switch (mode) { 1456 case 0: 1457 case 1: 1458 ilim = ilim1 = -1; 1459 i = 18; 1460 ndigits = 0; 1461 break; 1462 case 2: 1463 leftright = 0; 1464 /* no break */ 1465 case 4: 1466 if (ndigits <= 0) 1467 ndigits = 1; 1468 ilim = ilim1 = i = ndigits; 1469 break; 1470 case 3: 1471 leftright = 0; 1472 /* no break */ 1473 case 5: 1474 i = ndigits + k + 1; 1475 ilim = i; 1476 ilim1 = i - 1; 1477 if (i <= 0) 1478 i = 1; 1479 } 1480 s = s0 = rv_alloc(i); 1481 1482 if (ilim >= 0 && ilim <= Quick_max && try_quick) { 1483 1484 /* Try to get by with floating-point arithmetic. */ 1485 1486 i = 0; 1487 d2 = d; 1488 k0 = k; 1489 ilim0 = ilim; 1490 ieps = 2; /* conservative */ 1491 if (k > 0) { 1492 ds = tens[k&0xf]; 1493 j = k >> 4; 1494 if (j & Bletch) { 1495 /* prevent overflows */ 1496 j &= Bletch - 1; 1497 d /= bigtens[n_bigtens-1]; 1498 ieps++; 1499 } 1500 for (; j; j >>= 1, i++) 1501 if (j & 1) { 1502 ieps++; 1503 ds *= bigtens[i]; 1504 } 1505 d /= ds; 1506 } else if (j1 = -k) { 1507 d *= tens[j1 & 0xf]; 1508 for (j = j1 >> 4; j; j >>= 1, i++) 1509 if (j & 1) { 1510 ieps++; 1511 d *= bigtens[i]; 1512 } 1513 } 1514 if (k_check && d < 1. && ilim > 0) { 1515 if (ilim1 <= 0) 1516 goto fast_failed; 1517 ilim = ilim1; 1518 k--; 1519 d *= 10.; 1520 ieps++; 1521 } 1522 eps = ieps * d + 7.; 1523 word0(eps) -= (P - 1) * Exp_msk1; 1524 if (ilim == 0) { 1525 S = mhi = 0; 1526 d -= 5.; 1527 if (d > eps) 1528 goto one_digit; 1529 if (d < -eps) 1530 goto no_digits; 1531 goto fast_failed; 1532 } 1533 /* Generate ilim digits, then fix them up. */ 1534 eps *= tens[ilim-1]; 1535 for (i = 1; ; i++, d *= 10.) { 1536 L = d; 1537 d -= L; 1538 *s++ = '0' + (int)L; 1539 if (i == ilim) { 1540 if (d > 0.5 + eps) 1541 goto bump_up; 1542 else if (d < 0.5 - eps) { 1543 while (*--s == '0') 1544 ; 1545 s++; 1546 goto ret1; 1547 } 1548 break; 1549 } 1550 } 1551 fast_failed: 1552 s = s0; 1553 d = d2; 1554 k = k0; 1555 ilim = ilim0; 1556 } 1557 1558 /* Do we have a "small" integer? */ 1559 1560 if (be >= 0 && k <= Int_max) { 1561 /* Yes. */ 1562 ds = tens[k]; 1563 if (ndigits < 0 && ilim <= 0) { 1564 S = mhi = 0; 1565 if (ilim < 0 || d <= 5 * ds) 1566 goto no_digits; 1567 goto one_digit; 1568 } 1569 for (i = 1; ; i++) { 1570 L = d / ds; 1571 d -= L * ds; 1572 *s++ = '0' + (int)L; 1573 if (i == ilim) { 1574 d += d; 1575 if (d > ds || d == ds && L & 1) { 1576 bump_up: 1577 while (*--s == '9') 1578 if (s == s0) { 1579 k++; 1580 *s = '0'; 1581 break; 1582 } 1583 ++ * s++; 1584 } 1585 break; 1586 } 1587 if (!(d *= 10.)) 1588 break; 1589 } 1590 goto ret1; 1591 } 1592 1593 m2 = b2; 1594 m5 = b5; 1595 mhi = mlo = 0; 1596 if (leftright) { 1597 if (mode < 2) { 1598 i = 1599 #ifndef Sudden_Underflow 1600 denorm ? be + (Bias + (P - 1) - 1 + 1) : 1601 #endif 1602 1 + P - bbits; 1603 } else { 1604 j = ilim - 1; 1605 if (m5 >= j) 1606 m5 -= j; 1607 else { 1608 s5 += j -= m5; 1609 b5 += j; 1610 m5 = 0; 1611 } 1612 if ((i = ilim) < 0) { 1613 m2 -= i; 1614 i = 0; 1615 } 1616 } 1617 b2 += i; 1618 s2 += i; 1619 mhi = i2b(1); 1620 } 1621 if (m2 > 0 && s2 > 0) { 1622 i = m2 < s2 ? m2 : s2; 1623 b2 -= i; 1624 m2 -= i; 1625 s2 -= i; 1626 } 1627 if (b5 > 0) { 1628 if (leftright) { 1629 if (m5 > 0) { 1630 mhi = pow5mult(mhi, m5); 1631 b1 = mult(mhi, b); 1632 Bfree(b); 1633 b = b1; 1634 } 1635 if (j = b5 - m5) 1636 b = pow5mult(b, j); 1637 } else 1638 b = pow5mult(b, b5); 1639 } 1640 S = i2b(1); 1641 if (s5 > 0) 1642 S = pow5mult(S, s5); 1643 1644 /* Check for special case that d is a normalized power of 2. */ 1645 1646 spec_case = 0; 1647 if (mode < 2) { 1648 if (!word1(d) && !(word0(d) & Bndry_mask) 1649 #ifndef Sudden_Underflow 1650 && word0(d) & Exp_mask 1651 #endif 1652 ) { 1653 /* The special case */ 1654 b2 += Log2P; 1655 s2 += Log2P; 1656 spec_case = 1; 1657 } 1658 } 1659 1660 /* Arrange for convenient computation of quotients: 1661 * shift left if necessary so divisor has 4 leading 0 bits. 1662 * 1663 * Perhaps we should just compute leading 28 bits of S once 1664 * and for all and pass them and a shift to quorem, so it 1665 * can do shifts and ors to compute the numerator for q. 1666 */ 1667 if (i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f) 1668 i = 32 - i; 1669 if (i > 4) { 1670 i -= 4; 1671 b2 += i; 1672 m2 += i; 1673 s2 += i; 1674 } else if (i < 4) { 1675 i += 28; 1676 b2 += i; 1677 m2 += i; 1678 s2 += i; 1679 } 1680 if (b2 > 0) 1681 b = lshift(b, b2); 1682 if (s2 > 0) 1683 S = lshift(S, s2); 1684 if (k_check) { 1685 if (cmp(b, S) < 0) { 1686 k--; 1687 b = multadd(b, 10, 0); /* we botched the k estimate */ 1688 if (leftright) 1689 mhi = multadd(mhi, 10, 0); 1690 ilim = ilim1; 1691 } 1692 } 1693 if (ilim <= 0 && mode > 2) { 1694 if (ilim < 0 || cmp(b, S = multadd(S, 5, 0)) <= 0) { 1695 /* no digits, fcvt style */ 1696 no_digits: 1697 k = -1 - ndigits; 1698 goto ret; 1699 } 1700 one_digit: 1701 *s++ = '1'; 1702 k++; 1703 goto ret; 1704 } 1705 if (leftright) { 1706 if (m2 > 0) 1707 mhi = lshift(mhi, m2); 1708 1709 /* Compute mlo -- check for special case 1710 * that d is a normalized power of 2. 1711 */ 1712 1713 mlo = mhi; 1714 if (spec_case) { 1715 mhi = Balloc(mhi->k); 1716 Bcopy(mhi, mlo); 1717 mhi = lshift(mhi, Log2P); 1718 } 1719 1720 for (i = 1; ; i++) { 1721 dig = quorem(b, S) + '0'; 1722 /* Do we yet have the shortest decimal string 1723 * that will round to d? 1724 */ 1725 j = cmp(b, mlo); 1726 delta = diff(S, mhi); 1727 j1 = delta->sign ? 1 : cmp(b, delta); 1728 Bfree(delta); 1729 if (j1 == 0 && !mode && !(word1(d) & 1)) { 1730 if (dig == '9') 1731 goto round_9_up; 1732 if (j > 0) 1733 dig++; 1734 *s++ = dig; 1735 goto ret; 1736 } 1737 if (j < 0 || j == 0 && !mode 1738 && !(word1(d) & 1) 1739 ) { 1740 if (j1 > 0) { 1741 b = lshift(b, 1); 1742 j1 = cmp(b, S); 1743 if ((j1 > 0 || j1 == 0 && dig & 1) 1744 && dig++ == '9') 1745 goto round_9_up; 1746 } 1747 *s++ = dig; 1748 goto ret; 1749 } 1750 if (j1 > 0) { 1751 if (dig == '9') { /* possible if i == 1 */ 1752 round_9_up: 1753 *s++ = '9'; 1754 goto roundoff; 1755 } 1756 *s++ = dig + 1; 1757 goto ret; 1758 } 1759 *s++ = dig; 1760 if (i == ilim) 1761 break; 1762 b = multadd(b, 10, 0); 1763 if (mlo == mhi) 1764 mlo = mhi = multadd(mhi, 10, 0); 1765 else { 1766 mlo = multadd(mlo, 10, 0); 1767 mhi = multadd(mhi, 10, 0); 1768 } 1769 } 1770 } else 1771 for (i = 1; ; i++) { 1772 *s++ = dig = quorem(b, S) + '0'; 1773 if (i >= ilim) 1774 break; 1775 b = multadd(b, 10, 0); 1776 } 1777 1778 /* Round off last digit */ 1779 1780 b = lshift(b, 1); 1781 j = cmp(b, S); 1782 if (j > 0 || j == 0 && dig & 1) { 1783 roundoff: 1784 while (*--s == '9') 1785 if (s == s0) { 1786 k++; 1787 *s++ = '1'; 1788 goto ret; 1789 } 1790 ++ * s++; 1791 } else { 1792 while (*--s == '0') 1793 ; 1794 s++; 1795 } 1796 ret: 1797 Bfree(S); 1798 if (mhi) { 1799 if (mlo && mlo != mhi) 1800 Bfree(mlo); 1801 Bfree(mhi); 1802 } 1803 ret1: 1804 Bfree(b); 1805 *s = 0; 1806 *decpt = k + 1; 1807 if (rve) 1808 *rve = s; 1809 return s0; 1810 } 1811 1812