gdtoa/gdtoa-strtodg-fbsd.c

   1 /****************************************************************
   2
   3 The author of this software is David M. Gay.
   4
   5 Copyright (C) 1998-2001 by Lucent Technologies
   6 All Rights Reserved
   7
   8 Permission to use, copy, modify, and distribute this software and
   9 its documentation for any purpose and without fee is hereby
  10 granted, provided that the above copyright notice appear in all
  11 copies and that both that the copyright notice and this
  12 permission notice and warranty disclaimer appear in supporting
  13 documentation, and that the name of Lucent or any of its entities
  14 not be used in advertising or publicity pertaining to
  15 distribution of the software without specific, written prior
  16 permission.
  17
  18 LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
  19 INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
  20 IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
  21 SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  22 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
  23 IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
  24 ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
  25 THIS SOFTWARE.
  26
  27 ****************************************************************/
  28
  29 /* Please send bug reports to David M. Gay (dmg at acm dot org,
  30  * with " at " changed at "@" and " dot " changed to ".").      */
  31
  32 #include "xlocale_private.h"
  33
  34 #include "gdtoaimp.h"
  35
  36 #ifdef USE_LOCALE
  37 #include "locale.h"
  38 #endif
  39
  40 #define fivesbits __fivesbits_D2A
  41 #define all_on __all_on_D2A
  42 #define set_ones __set_ones_D2A
  43 #define rvOK __rvOK_D2A
  44 #define mantbits __mantbits_D2A
  45
  46 #ifdef BUILDING_VARIANT
  47 extern CONST int fivesbits[];
  48 int all_on(Bigint *b, int n);
  49 Bigint *set_ones(Bigint *b, int n);
  50 int rvOK(double d, FPI *fpi, Long *exp, ULong *bits, int exact, int rd, int *irv);
  51 int mantbits(double d);
  52 #else /* !BUILDING_VARIANT */
  53
  54  __private_extern__ CONST int
  55 fivesbits[] = {  0,  3,  5,  7, 10, 12, 14, 17, 19, 21,
  56                 24, 26, 28, 31, 33, 35, 38, 40, 42, 45,
  57                 47, 49, 52
  58 #ifdef VAX
  59                 , 54, 56
  60 #endif
  61                 };
  62
  63  Bigint *
  64 #ifdef KR_headers
  65 increment(b) Bigint *b;
  66 #else
  67 increment(Bigint *b)
  68 #endif
  69 {
  70         ULong *x, *xe;
  71         Bigint *b1;
  72 #ifdef Pack_16
  73         ULong carry = 1, y;
  74 #endif
  75
  76         x = b->x;
  77         xe = x + b->wds;
  78 #ifdef Pack_32
  79         do {
  80                 if (*x < (ULong)0xffffffffL) {
  81                         ++*x;
  82                         return b;
  83                         }
  84                 *x++ = 0;
  85                 } while(x < xe);
  86 #else
  87         do {
  88                 y = *x + carry;
  89                 carry = y >> 16;
  90                 *x++ = y & 0xffff;
  91                 if (!carry)
  92                         return b;
  93                 } while(x < xe);
  94         if (carry)
  95 #endif
  96         {
  97                 if (b->wds >= b->maxwds) {
  98                         b1 = Balloc(b->k+1);
  99                         Bcopy(b1,b);
 100                         Bfree(b);
 101                         b = b1;
 102                         }
 103                 b->x[b->wds++] = 1;
 104                 }
 105         return b;
 106         }
 107
 108  int
 109 #ifdef KR_headers
 110 decrement(b) Bigint *b;
 111 #else
 112 decrement(Bigint *b)
 113 #endif
 114 {
 115         ULong *x, *xe;
 116 #ifdef Pack_16
 117         ULong borrow = 1, y;
 118 #endif
 119
 120         x = b->x;
 121         xe = x + b->wds;
 122 #ifdef Pack_32
 123         do {
 124                 if (*x) {
 125                         --*x;
 126                         break;
 127                         }
 128                 *x++ = 0xffffffffL;
 129                 }
 130                 while(x < xe);
 131 #else
 132         do {
 133                 y = *x - borrow;
 134                 borrow = (y & 0x10000) >> 16;
 135                 *x++ = y & 0xffff;
 136                 } while(borrow && x < xe);
 137 #endif
 138         return STRTOG_Inexlo;
 139         }
 140
 141  __private_extern__ int
 142 #ifdef KR_headers
 143 all_on(b, n) Bigint *b; int n;
 144 #else
 145 all_on(Bigint *b, int n)
 146 #endif
 147 {
 148         ULong *x, *xe;
 149
 150         x = b->x;
 151         xe = x + (n >> kshift);
 152         while(x < xe)
 153                 if ((*x++ & ALL_ON) != ALL_ON)
 154                         return 0;
 155         if (n &= kmask)
 156                 return ((*x | (ALL_ON << n)) & ALL_ON) == ALL_ON;
 157         return 1;
 158         }
 159
 160  Bigint *
 161 #ifdef KR_headers
 162 set_ones(b, n) Bigint *b; int n;
 163 #else
 164 set_ones(Bigint *b, int n)
 165 #endif
 166 {
 167         int k;
 168         ULong *x, *xe;
 169
 170         k = (n + ((1 << kshift) - 1)) >> kshift;
 171         if (b->k < k) {
 172                 Bfree(b);
 173                 b = Balloc(k);
 174                 }
 175         k = n >> kshift;
 176         if (n &= kmask)
 177                 k++;
 178         b->wds = k;
 179         x = b->x;
 180         xe = x + k;
 181         while(x < xe)
 182                 *x++ = ALL_ON;
 183         if (n)
 184                 x[-1] >>= ULbits - n;
 185         return b;
 186         }
 187
 188  __private_extern__ int
 189 rvOK
 190 #ifdef KR_headers
 191  (d, fpi, exp, bits, exact, rd, irv)
 192  double d; FPI *fpi; Long *exp; ULong *bits; int exact, rd, *irv;
 193 #else
 194  (double d, FPI *fpi, Long *exp, ULong *bits, int exact, int rd, int *irv)
 195 #endif
 196 {
 197         Bigint *b;
 198         ULong carry, inex, lostbits;
 199         int bdif, e, j, k, k1, nb, rv;
 200
 201         carry = rv = 0;
 202         b = d2b(d, &e, &bdif);
 203         bdif -= nb = fpi->nbits;
 204         e += bdif;
 205         if (bdif <= 0) {
 206                 if (exact)
 207                         goto trunc;
 208                 goto ret;
 209                 }
 210         if (P == nb) {
 211                 if (
 212 #ifndef IMPRECISE_INEXACT
 213                         exact &&
 214 #endif
 215                         fpi->rounding ==
 216 #ifdef RND_PRODQUOT
 217                                         FPI_Round_near
 218 #else
 219                                         Flt_Rounds
 220 #endif
 221                         ) goto trunc;
 222                 goto ret;
 223                 }
 224         switch(rd) {
 225           case 1:
 226                 goto trunc;
 227           case 2:
 228                 break;
 229           default: /* round near */
 230                 k = bdif - 1;
 231                 if (k < 0)
 232                         goto trunc;
 233                 if (!k) {
 234                         if (!exact)
 235                                 goto ret;
 236                         if (b->x[0] & 2)
 237                                 break;
 238                         goto trunc;
 239                         }
 240                 if (b->x[k>>kshift] & ((ULong)1 << (k & kmask)))
 241                         break;
 242                 goto trunc;
 243           }
 244         /* "break" cases: round up 1 bit, then truncate; bdif > 0 */
 245         carry = 1;
 246  trunc:
 247         inex = lostbits = 0;
 248         if (bdif > 0) {
 249                 if ( (lostbits = any_on(b, bdif)) !=0)
 250                         inex = STRTOG_Inexlo;
 251                 rshift(b, bdif);
 252                 if (carry) {
 253                         inex = STRTOG_Inexhi;
 254                         b = increment(b);
 255                         if ( (j = nb & kmask) !=0)
 256                                 j = ULbits - j;
 257                         if (hi0bits(b->x[b->wds - 1]) != j) {
 258                                 if (!lostbits)
 259                                         lostbits = b->x[0] & 1;
 260                                 rshift(b, 1);
 261                                 e++;
 262                                 }
 263                         }
 264                 }
 265         else if (bdif < 0)
 266                 b = lshift(b, -bdif);
 267         if (e < fpi->emin) {
 268                 k = fpi->emin - e;
 269                 e = fpi->emin;
 270                 if (k > nb || fpi->sudden_underflow) {
 271                         b->wds = inex = 0;
 272                         *irv = STRTOG_Underflow | STRTOG_Inexlo;
 273                         }
 274                 else {
 275                         k1 = k - 1;
 276                         if (k1 > 0 && !lostbits)
 277                                 lostbits = any_on(b, k1);
 278                         if (!lostbits && !exact)
 279                                 goto ret;
 280                         lostbits |=
 281                           carry = b->x[k1>>kshift] & (1 << (k1 & kmask));
 282                         rshift(b, k);
 283                         *irv = STRTOG_Denormal;
 284                         if (carry) {
 285                                 b = increment(b);
 286                                 inex = STRTOG_Inexhi | STRTOG_Underflow;
 287                                 }
 288                         else if (lostbits)
 289                                 inex = STRTOG_Inexlo | STRTOG_Underflow;
 290                         }
 291                 }
 292         else if (e > fpi->emax) {
 293                 e = fpi->emax + 1;
 294                 *irv = STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;
 295 #ifndef NO_ERRNO
 296                 errno = ERANGE;
 297 #endif
 298                 b->wds = inex = 0;
 299                 }
 300         *exp = e;
 301         copybits(bits, nb, b);
 302         *irv |= inex;
 303         rv = 1;
 304  ret:
 305         Bfree(b);
 306         return rv;
 307         }
 308
 309  __private_extern__ int
 310 #ifdef KR_headers
 311 mantbits(d) double d;
 312 #else
 313 mantbits(double d)
 314 #endif
 315 {
 316         ULong L;
 317 #ifdef VAX
 318         L = word1(d) << 16 | word1(d) >> 16;
 319         if (L)
 320 #else
 321         if ( (L = word1(d)) !=0)
 322 #endif
 323                 return P - lo0bits(&L);
 324 #ifdef VAX
 325         L = word0(d) << 16 | word0(d) >> 16 | Exp_msk11;
 326 #else
 327         L = word0(d) | Exp_msk1;
 328 #endif
 329         return P - 32 - lo0bits(&L);
 330         }
 331
 332 #endif /* BUILDING_VARIANT */
 333
 334  int
 335 strtodg
 336 #ifdef KR_headers
 337         (s00, se, fpi, exp, bits, loc)
 338         CONST char *s00; char **se; FPI *fpi; Long *exp; ULong *bits; locale_t loc;
 339 #else
 340         (CONST char *s00, char **se, FPI *fpi, Long *exp, ULong *bits, locale_t loc)
 341 #endif
 342 {
 343         int abe, abits, asub;
 344         int bb0, bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, decpt, denorm;
 345         int dsign, e, e1, e2, emin, esign, finished, i, inex, irv;
 346         int j, k, nbits, nd, nd0, nf, nz, nz0, rd, rvbits, rve, rve1, sign;
 347         int sudden_underflow;
 348         CONST char *s, *s0, *s1;
 349         double adj, adj0, rv, tol;
 350         Long L;
 351         ULong y, z;
 352         Bigint *ab, *bb, *bb1, *bd, *bd0, *bs, *delta, *rvb, *rvb0;
 353 #ifdef USE_LOCALE
 354         char *decimal_point;
 355         int decimal_point_len;
 356 #endif /* USE_LOCALE */
 357
 358         irv = STRTOG_Zero;
 359         denorm = sign = nz0 = nz = 0;
 360         dval(rv) = 0.;
 361         rvb = 0;
 362         nbits = fpi->nbits;
 363         for(s = s00;;s++) switch(*s) {
 364                 case '-':
 365                         sign = 1;
 366                         /* no break */
 367                 case '+':
 368                         if (*++s)
 369                                 goto break2;
 370                         /* no break */
 371                 case 0:
 372                         sign = 0;
 373                         irv = STRTOG_NoNumber;
 374                         s = s00;
 375                         goto ret;
 376                 case '\t':
 377                 case '\n':
 378                 case '\v':
 379                 case '\f':
 380                 case '\r':
 381                 case ' ':
 382                         continue;
 383                 default:
 384                         goto break2;
 385                 }
 386  break2:
 387         if (*s == '0') {
 388 #ifndef NO_HEX_FP
 389                 switch(s[1]) {
 390                   case 'x':
 391                   case 'X':
 392                         irv = gethex(&s, fpi, exp, &rvb, sign, loc);
 393                         if (irv == STRTOG_NoNumber) {
 394                                 s = s00;
 395                                 sign = 0;
 396                                 }
 397                         goto ret;
 398                   }
 399 #endif
 400                 nz0 = 1;
 401                 while(*++s == '0') ;
 402                 if (!*s)
 403                         goto ret;
 404                 }
 405         sudden_underflow = fpi->sudden_underflow;
 406         s0 = s;
 407         y = z = 0;
 408         for(decpt = nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
 409                 if (nd < 9)
 410                         y = 10*y + c - '0';
 411                 else if (nd < 16)
 412                         z = 10*z + c - '0';
 413         nd0 = nd;
 414         NORMALIZE_LOCALE(loc);
 415 #ifdef USE_LOCALE
 416         decimal_point = localeconv_l(loc)->decimal_point;
 417         decimal_point_len = strlen(decimal_point);
 418         if (strncmp(s, decimal_point, decimal_point_len) == 0)
 419 #else
 420         if (c == '.')
 421 #endif
 422                 {
 423                 decpt = 1;
 424 #ifdef USE_LOCALE
 425                 s += decimal_point_len;
 426                 c = *s;
 427 #else
 428                 c = *++s;
 429 #endif
 430                 if (!nd) {
 431                         for(; c == '0'; c = *++s)
 432                                 nz++;
 433                         if (c > '0' && c <= '9') {
 434                                 s0 = s;
 435                                 nf += nz;
 436                                 nz = 0;
 437                                 goto have_dig;
 438                                 }
 439                         goto dig_done;
 440                         }
 441                 for(; c >= '0' && c <= '9'; c = *++s) {
 442  have_dig:
 443                         nz++;
 444                         if (c -= '0') {
 445                                 nf += nz;
 446                                 for(i = 1; i < nz; i++)
 447                                         if (nd++ < 9)
 448                                                 y *= 10;
 449                                         else if (nd <= DBL_DIG + 1)
 450                                                 z *= 10;
 451                                 if (nd++ < 9)
 452                                         y = 10*y + c;
 453                                 else if (nd <= DBL_DIG + 1)
 454                                         z = 10*z + c;
 455                                 nz = 0;
 456                                 }
 457                         }
 458                 }
 459  dig_done:
 460         e = 0;
 461         if (c == 'e' || c == 'E') {
 462                 if (!nd && !nz && !nz0) {
 463                         irv = STRTOG_NoNumber;
 464                         s = s00;
 465                         goto ret;
 466                         }
 467                 s00 = s;
 468                 esign = 0;
 469                 switch(c = *++s) {
 470                         case '-':
 471                                 esign = 1;
 472                         case '+':
 473                                 c = *++s;
 474                         }
 475                 if (c >= '0' && c <= '9') {
 476                         while(c == '0')
 477                                 c = *++s;
 478                         if (c > '0' && c <= '9') {
 479                                 L = c - '0';
 480                                 s1 = s;
 481                                 while((c = *++s) >= '0' && c <= '9')
 482                                         L = 10*L + c - '0';
 483                                 if (s - s1 > 8 || L > 19999)
 484                                         /* Avoid confusion from exponents
 485                                          * so large that e might overflow.
 486                                          */
 487                                         e = 19999; /* safe for 16 bit ints */
 488                                 else
 489                                         e = (int)L;
 490                                 if (esign)
 491                                         e = -e;
 492                                 }
 493                         else
 494                                 e = 0;
 495                         }
 496                 else
 497                         s = s00;
 498                 }
 499         if (!nd) {
 500                 if (!nz && !nz0) {
 501 #ifdef INFNAN_CHECK
 502                         /* Check for Nan and Infinity */
 503                         if (!decpt)
 504                          switch(c) {
 505                           case 'i':
 506                           case 'I':
 507                                 if (match(&s,"nf")) {
 508                                         --s;
 509                                         if (!match(&s,"inity"))
 510                                                 ++s;
 511                                         irv = STRTOG_Infinite;
 512                                         goto infnanexp;
 513                                         }
 514                                 break;
 515                           case 'n':
 516                           case 'N':
 517                                 if (match(&s, "an")) {
 518                                         irv = STRTOG_NaN;
 519                                         *exp = fpi->emax + 1;
 520 #ifndef No_Hex_NaN
 521                                         if (*s == '(') /*)*/
 522                                                 irv = hexnan(&s, fpi, bits);
 523 #endif
 524                                         goto infnanexp;
 525                                         }
 526                           }
 527 #endif /* INFNAN_CHECK */
 528                         irv = STRTOG_NoNumber;
 529                         s = s00;
 530                         }
 531                 goto ret;
 532                 }
 533
 534         irv = STRTOG_Normal;
 535         e1 = e -= nf;
 536         rd = 0;
 537         switch(fpi->rounding & 3) {
 538           case FPI_Round_up:
 539                 rd = 2 - sign;
 540                 break;
 541           case FPI_Round_zero:
 542                 rd = 1;
 543                 break;
 544           case FPI_Round_down:
 545                 rd = 1 + sign;
 546           }
 547
 548         /* Now we have nd0 digits, starting at s0, followed by a
 549          * decimal point, followed by nd-nd0 digits.  The number we're
 550          * after is the integer represented by those digits times
 551          * 10**e */
 552
 553         if (!nd0)
 554                 nd0 = nd;
 555         k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
 556         dval(rv) = y;
 557         if (k > 9)
 558                 dval(rv) = tens[k - 9] * dval(rv) + z;
 559         bd0 = 0;
 560         if (nbits <= P && nd <= DBL_DIG) {
 561                 if (!e) {
 562                         if (rvOK(dval(rv), fpi, exp, bits, 1, rd, &irv))
 563                                 goto ret;
 564                         }
 565                 else if (e > 0) {
 566                         if (e <= Ten_pmax) {
 567 #ifdef VAX
 568                                 goto vax_ovfl_check;
 569 #else
 570                                 i = fivesbits[e] + mantbits(dval(rv)) <= P;
 571                                 /* rv = */ rounded_product(dval(rv), tens[e]);
 572                                 if (rvOK(dval(rv), fpi, exp, bits, i, rd, &irv))
 573                                         goto ret;
 574                                 e1 -= e;
 575                                 goto rv_notOK;
 576 #endif
 577                                 }
 578                         i = DBL_DIG - nd;
 579                         if (e <= Ten_pmax + i) {
 580                                 /* A fancier test would sometimes let us do
 581                                  * this for larger i values.
 582                                  */
 583                                 e2 = e - i;
 584                                 e1 -= i;
 585                                 dval(rv) *= tens[i];
 586 #ifdef VAX
 587                                 /* VAX exponent range is so narrow we must
 588                                  * worry about overflow here...
 589                                  */
 590  vax_ovfl_check:
 591                                 dval(adj) = dval(rv);
 592                                 word0(adj) -= P*Exp_msk1;
 593                                 /* adj = */ rounded_product(dval(adj), tens[e2]);
 594                                 if ((word0(adj) & Exp_mask)
 595                                  > Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
 596                                         goto rv_notOK;
 597                                 word0(adj) += P*Exp_msk1;
 598                                 dval(rv) = dval(adj);
 599 #else
 600                                 /* rv = */ rounded_product(dval(rv), tens[e2]);
 601 #endif
 602                                 if (rvOK(dval(rv), fpi, exp, bits, 0, rd, &irv))
 603                                         goto ret;
 604                                 e1 -= e2;
 605                                 }
 606                         }
 607 #ifndef Inaccurate_Divide
 608                 else if (e >= -Ten_pmax) {
 609                         /* rv = */ rounded_quotient(dval(rv), tens[-e]);
 610                         if (rvOK(dval(rv), fpi, exp, bits, 0, rd, &irv))
 611                                 goto ret;
 612                         e1 -= e;
 613                         }
 614 #endif
 615                 }
 616  rv_notOK:
 617         e1 += nd - k;
 618
 619         /* Get starting approximation = rv * 10**e1 */
 620
 621         e2 = 0;
 622         if (e1 > 0) {
 623                 if ( (i = e1 & 15) !=0)
 624                         dval(rv) *= tens[i];
 625                 if (e1 &= ~15) {
 626                         e1 >>= 4;
 627                         while(e1 >= (1 << n_bigtens-1)) {
 628                                 e2 += ((word0(rv) & Exp_mask)
 629                                         >> Exp_shift1) - Bias;
 630                                 word0(rv) &= ~Exp_mask;
 631                                 word0(rv) |= Bias << Exp_shift1;
 632                                 dval(rv) *= bigtens[n_bigtens-1];
 633                                 e1 -= 1 << n_bigtens-1;
 634                                 }
 635                         e2 += ((word0(rv) & Exp_mask) >> Exp_shift1) - Bias;
 636                         word0(rv) &= ~Exp_mask;
 637                         word0(rv) |= Bias << Exp_shift1;
 638                         for(j = 0; e1 > 0; j++, e1 >>= 1)
 639                                 if (e1 & 1)
 640                                         dval(rv) *= bigtens[j];
 641                         }
 642                 }
 643         else if (e1 < 0) {
 644                 e1 = -e1;
 645                 if ( (i = e1 & 15) !=0)
 646                         dval(rv) /= tens[i];
 647                 if (e1 &= ~15) {
 648                         e1 >>= 4;
 649                         while(e1 >= (1 << n_bigtens-1)) {
 650                                 e2 += ((word0(rv) & Exp_mask)
 651                                         >> Exp_shift1) - Bias;
 652                                 word0(rv) &= ~Exp_mask;
 653                                 word0(rv) |= Bias << Exp_shift1;
 654                                 dval(rv) *= tinytens[n_bigtens-1];
 655                                 e1 -= 1 << n_bigtens-1;
 656                                 }
 657                         e2 += ((word0(rv) & Exp_mask) >> Exp_shift1) - Bias;
 658                         word0(rv) &= ~Exp_mask;
 659                         word0(rv) |= Bias << Exp_shift1;
 660                         for(j = 0; e1 > 0; j++, e1 >>= 1)
 661                                 if (e1 & 1)
 662                                         dval(rv) *= tinytens[j];
 663                         }
 664                 }
 665 #ifdef IBM
 666         /* e2 is a correction to the (base 2) exponent of the return
 667          * value, reflecting adjustments above to avoid overflow in the
 668          * native arithmetic.  For native IBM (base 16) arithmetic, we
 669          * must multiply e2 by 4 to change from base 16 to 2.
 670          */
 671         e2 <<= 2;
 672 #endif
 673         rvb = d2b(dval(rv), &rve, &rvbits);     /* rv = rvb * 2^rve */
 674         rve += e2;
 675         if ((j = rvbits - nbits) > 0) {
 676                 rshift(rvb, j);
 677                 rvbits = nbits;
 678                 rve += j;
 679                 }
 680         bb0 = 0;        /* trailing zero bits in rvb */
 681         e2 = rve + rvbits - nbits;
 682         if (e2 > fpi->emax + 1)
 683                 goto huge;
 684         rve1 = rve + rvbits - nbits;
 685         if (e2 < (emin = fpi->emin)) {
 686                 denorm = 1;
 687                 j = rve - emin;
 688                 if (j > 0) {
 689                         rvb = lshift(rvb, j);
 690                         rvbits += j;
 691                         }
 692                 else if (j < 0) {
 693                         rvbits += j;
 694                         if (rvbits <= 0) {
 695                                 if (rvbits < -1) {
 696  ufl:
 697                                         rvb->wds = 0;
 698                                         rvb->x[0] = 0;
 699                                         *exp = emin;
 700                                         irv = STRTOG_Underflow | STRTOG_Inexlo;
 701 #ifndef NO_ERRNO
 702                                         errno = ERANGE;
 703 #endif
 704                                         goto ret;
 705                                         }
 706                                 rvb->x[0] = rvb->wds = rvbits = 1;
 707                                 }
 708                         else
 709                                 rshift(rvb, -j);
 710                         }
 711                 rve = rve1 = emin;
 712                 if (sudden_underflow && e2 + 1 < emin)
 713                         goto ufl;
 714                 }
 715
 716         /* Now the hard part -- adjusting rv to the correct value.*/
 717
 718         /* Put digits into bd: true value = bd * 10^e */
 719
 720 #ifdef USE_LOCALE
 721         bd0 = s2b(s0, nd0, nd, y, decimal_point_len);
 722 #else
 723         bd0 = s2b(s0, nd0, nd, y, 1);
 724 #endif
 725
 726         for(;;) {
 727                 bd = Balloc(bd0->k);
 728                 Bcopy(bd, bd0);
 729                 bb = Balloc(rvb->k);
 730                 Bcopy(bb, rvb);
 731                 bbbits = rvbits - bb0;
 732                 bbe = rve + bb0;
 733                 bs = i2b(1);
 734
 735                 if (e >= 0) {
 736                         bb2 = bb5 = 0;
 737                         bd2 = bd5 = e;
 738                         }
 739                 else {
 740                         bb2 = bb5 = -e;
 741                         bd2 = bd5 = 0;
 742                         }
 743                 if (bbe >= 0)
 744                         bb2 += bbe;
 745                 else
 746                         bd2 -= bbe;
 747                 bs2 = bb2;
 748                 j = nbits + 1 - bbbits;
 749                 i = bbe + bbbits - nbits;
 750                 if (i < emin)   /* denormal */
 751                         j += i - emin;
 752                 bb2 += j;
 753                 bd2 += j;
 754                 i = bb2 < bd2 ? bb2 : bd2;
 755                 if (i > bs2)
 756                         i = bs2;
 757                 if (i > 0) {
 758                         bb2 -= i;
 759                         bd2 -= i;
 760                         bs2 -= i;
 761                         }
 762                 if (bb5 > 0) {
 763                         bs = pow5mult(bs, bb5);
 764                         bb1 = mult(bs, bb);
 765                         Bfree(bb);
 766                         bb = bb1;
 767                         }
 768                 bb2 -= bb0;
 769                 if (bb2 > 0)
 770                         bb = lshift(bb, bb2);
 771                 else if (bb2 < 0)
 772                         rshift(bb, -bb2);
 773                 if (bd5 > 0)
 774                         bd = pow5mult(bd, bd5);
 775                 if (bd2 > 0)
 776                         bd = lshift(bd, bd2);
 777                 if (bs2 > 0)
 778                         bs = lshift(bs, bs2);
 779                 asub = 1;
 780                 inex = STRTOG_Inexhi;
 781                 delta = diff(bb, bd);
 782                 if (delta->wds <= 1 && !delta->x[0])
 783                         break;
 784                 dsign = delta->sign;
 785                 delta->sign = finished = 0;
 786                 L = 0;
 787                 i = cmp(delta, bs);
 788                 if (rd && i <= 0) {
 789                         irv = STRTOG_Normal;
 790                         if ( (finished = dsign ^ (rd&1)) !=0) {
 791                                 if (dsign != 0) {
 792                                         irv |= STRTOG_Inexhi;
 793                                         goto adj1;
 794                                         }
 795                                 irv |= STRTOG_Inexlo;
 796                                 if (rve1 == emin)
 797                                         goto adj1;
 798                                 for(i = 0, j = nbits; j >= ULbits;
 799                                                 i++, j -= ULbits) {
 800                                         if (rvb->x[i] & ALL_ON)
 801                                                 goto adj1;
 802                                         }
 803                                 if (j > 1 && lo0bits(rvb->x + i) < j - 1)
 804                                         goto adj1;
 805                                 rve = rve1 - 1;
 806                                 rvb = set_ones(rvb, rvbits = nbits);
 807                                 break;
 808                                 }
 809                         irv |= dsign ? STRTOG_Inexlo : STRTOG_Inexhi;
 810                         break;
 811                         }
 812                 if (i < 0) {
 813                         /* Error is less than half an ulp -- check for
 814                          * special case of mantissa a power of two.
 815                          */
 816                         irv = dsign
 817                                 ? STRTOG_Normal | STRTOG_Inexlo
 818                                 : STRTOG_Normal | STRTOG_Inexhi;
 819                         if (dsign || bbbits > 1 || denorm || rve1 == emin)
 820                                 break;
 821                         delta = lshift(delta,1);
 822                         if (cmp(delta, bs) > 0) {
 823                                 irv = STRTOG_Normal | STRTOG_Inexlo;
 824                                 goto drop_down;
 825                                 }
 826                         break;
 827                         }
 828                 if (i == 0) {
 829                         /* exactly half-way between */
 830                         if (dsign) {
 831                                 if (denorm && all_on(rvb, rvbits)) {
 832                                         /*boundary case -- increment exponent*/
 833                                         rvb->wds = 1;
 834                                         rvb->x[0] = 1;
 835                                         rve = emin + nbits - (rvbits = 1);
 836                                         irv = STRTOG_Normal | STRTOG_Inexhi;
 837                                         denorm = 0;
 838                                         break;
 839                                         }
 840                                 irv = STRTOG_Normal | STRTOG_Inexlo;
 841                                 }
 842                         else if (bbbits == 1) {
 843                                 irv = STRTOG_Normal;
 844  drop_down:
 845                                 /* boundary case -- decrement exponent */
 846                                 if (rve1 == emin) {
 847                                         irv = STRTOG_Normal | STRTOG_Inexhi;
 848                                         if (rvb->wds == 1 && rvb->x[0] == 1)
 849                                                 sudden_underflow = 1;
 850                                         break;
 851                                         }
 852                                 rve -= nbits;
 853                                 rvb = set_ones(rvb, rvbits = nbits);
 854                                 break;
 855                                 }
 856                         else
 857                                 irv = STRTOG_Normal | STRTOG_Inexhi;
 858                         if (bbbits < nbits && !denorm || !(rvb->x[0] & 1))
 859                                 break;
 860                         if (dsign) {
 861                                 rvb = increment(rvb);
 862                                 if ( (j = rvbits & kmask) !=0)
 863                                         j = ULbits - j;
 864                                 if (hi0bits(rvb->x[rvb->wds - 1])
 865                                                 != j)
 866                                         rvbits++;
 867                                 irv = STRTOG_Normal | STRTOG_Inexhi;
 868                                 }
 869                         else {
 870                                 if (bbbits == 1)
 871                                         goto undfl;
 872                                 decrement(rvb);
 873                                 irv = STRTOG_Normal | STRTOG_Inexlo;
 874                                 }
 875                         break;
 876                         }
 877                 if ((dval(adj) = ratio(delta, bs)) <= 2.) {
 878  adj1:
 879                         inex = STRTOG_Inexlo;
 880                         if (dsign) {
 881                                 asub = 0;
 882                                 inex = STRTOG_Inexhi;
 883                                 }
 884                         else if (denorm && bbbits <= 1) {
 885  undfl:
 886                                 rvb->wds = 0;
 887                                 rve = emin;
 888                                 irv = STRTOG_Underflow | STRTOG_Inexlo;
 889                                 break;
 890                                 }
 891                         adj0 = dval(adj) = 1.;
 892                         }
 893                 else {
 894                         adj0 = dval(adj) *= 0.5;
 895                         if (dsign) {
 896                                 asub = 0;
 897                                 inex = STRTOG_Inexlo;
 898                                 }
 899                         if (dval(adj) < 2147483647.) {
 900                                 L = adj0;
 901                                 adj0 -= L;
 902                                 switch(rd) {
 903                                   case 0:
 904                                         if (adj0 >= .5)
 905                                                 goto inc_L;
 906                                         break;
 907                                   case 1:
 908                                         if (asub && adj0 > 0.)
 909                                                 goto inc_L;
 910                                         break;
 911                                   case 2:
 912                                         if (!asub && adj0 > 0.) {
 913  inc_L:
 914                                                 L++;
 915                                                 inex = STRTOG_Inexact - inex;
 916                                                 }
 917                                   }
 918                                 dval(adj) = L;
 919                                 }
 920                         }
 921                 y = rve + rvbits;
 922
 923                 /* adj *= ulp(dval(rv)); */
 924                 /* if (asub) rv -= adj; else rv += adj; */
 925
 926                 if (!denorm && rvbits < nbits) {
 927                         rvb = lshift(rvb, j = nbits - rvbits);
 928                         rve -= j;
 929                         rvbits = nbits;
 930                         }
 931                 ab = d2b(dval(adj), &abe, &abits);
 932                 if (abe < 0)
 933                         rshift(ab, -abe);
 934                 else if (abe > 0)
 935                         ab = lshift(ab, abe);
 936                 rvb0 = rvb;
 937                 if (asub) {
 938                         /* rv -= adj; */
 939                         j = hi0bits(rvb->x[rvb->wds-1]);
 940                         rvb = diff(rvb, ab);
 941                         k = rvb0->wds - 1;
 942                         if (denorm)
 943                                 /* do nothing */;
 944                         else if (rvb->wds <= k
 945                                 || hi0bits( rvb->x[k]) >
 946                                    hi0bits(rvb0->x[k])) {
 947                                 /* unlikely; can only have lost 1 high bit */
 948                                 if (rve1 == emin) {
 949                                         --rvbits;
 950                                         denorm = 1;
 951                                         }
 952                                 else {
 953                                         rvb = lshift(rvb, 1);
 954                                         --rve;
 955                                         --rve1;
 956                                         L = finished = 0;
 957                                         }
 958                                 }
 959                         }
 960                 else {
 961                         rvb = sum(rvb, ab);
 962                         k = rvb->wds - 1;
 963                         if (k >= rvb0->wds
 964                          || hi0bits(rvb->x[k]) < hi0bits(rvb0->x[k])) {
 965                                 if (denorm) {
 966                                         if (++rvbits == nbits)
 967                                                 denorm = 0;
 968                                         }
 969                                 else {
 970                                         rshift(rvb, 1);
 971                                         rve++;
 972                                         rve1++;
 973                                         L = 0;
 974                                         }
 975                                 }
 976                         }
 977                 Bfree(ab);
 978                 Bfree(rvb0);
 979                 if (finished)
 980                         break;
 981
 982                 z = rve + rvbits;
 983                 if (y == z && L) {
 984                         /* Can we stop now? */
 985                         tol = dval(adj) * 5e-16; /* > max rel error */
 986                         dval(adj) = adj0 - .5;
 987                         if (dval(adj) < -tol) {
 988                                 if (adj0 > tol) {
 989                                         irv |= inex;
 990                                         break;
 991                                         }
 992                                 }
 993                         else if (dval(adj) > tol && adj0 < 1. - tol) {
 994                                 irv |= inex;
 995                                 break;
 996                                 }
 997                         }
 998                 bb0 = denorm ? 0 : trailz(rvb);
 999                 Bfree(bb);
1000                 Bfree(bd);
1001                 Bfree(bs);
1002                 Bfree(delta);
1003                 }
1004         if (!denorm && (j = nbits - rvbits)) {
1005                 if (j > 0)
1006                         rvb = lshift(rvb, j);
1007                 else
1008                         rshift(rvb, -j);
1009                 rve -= j;
1010                 }
1011         *exp = rve;
1012         Bfree(bb);
1013         Bfree(bd);
1014         Bfree(bs);
1015         Bfree(bd0);
1016         Bfree(delta);
1017         if (rve > fpi->emax) {
1018  huge:
1019                 rvb->wds = 0;
1020                 irv = STRTOG_Infinite | STRTOG_Overflow | STRTOG_Inexhi;
1021 #ifndef NO_ERRNO
1022                 errno = ERANGE;
1023 #endif
1024  infnanexp:
1025                 *exp = fpi->emax + 1;
1026                 }
1027  ret:
1028         if (denorm) {
1029                 if (sudden_underflow) {
1030                         rvb->wds = 0;
1031                         irv = STRTOG_Underflow | STRTOG_Inexlo;
1032                         }
1033                 else  {
1034                         irv = (irv & ~STRTOG_Retmask) |
1035                                 (rvb->wds > 0 ? STRTOG_Denormal : STRTOG_Zero);
1036                         if (irv & STRTOG_Inexact)
1037                                 irv |= STRTOG_Underflow;
1038                         }
1039                 }
1040         if (se)
1041                 *se = (char *)s;
1042         if (sign)
1043                 irv |= STRTOG_Neg;
1044         if (rvb) {
1045                 copybits(bits, nbits, rvb);
1046                 Bfree(rvb);
1047                 }
1048 #if !defined(NO_ERRNO) && __DARWIN_UNIX03
1049         if (irv & STRTOG_Underflow)
1050                 errno = ERANGE;
1051 #endif
1052         return irv;
1053         }