numeric.c

   1 /*    numeric.c
   2  *
   3  *    Copyright (c) 2001, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * "That only makes eleven (plus one mislaid) and not fourteen, unless
  12  * wizards count differently to other people."
  13  */
  14
  15 #include "EXTERN.h"
  16 #define PERL_IN_NUMERIC_C
  17 #include "perl.h"
  18
  19 U32
  20 Perl_cast_ulong(pTHX_ NV f)
  21 {
  22   if (f < 0.0)
  23     return f < I32_MIN ? (U32) I32_MIN : (U32)(I32) f;
  24   if (f < U32_MAX_P1) {
  25 #if CASTFLAGS & 2
  26     if (f < U32_MAX_P1_HALF)
  27       return (U32) f;
  28     f -= U32_MAX_P1_HALF;
  29     return ((U32) f) | (1 + U32_MAX >> 1);
  30 #else
  31     return (U32) f;
  32 #endif
  33   }
  34   return f > 0 ? U32_MAX : 0 /* NaN */;
  35 }
  36
  37 I32
  38 Perl_cast_i32(pTHX_ NV f)
  39 {
  40   if (f < I32_MAX_P1)
  41     return f < I32_MIN ? I32_MIN : (I32) f;
  42   if (f < U32_MAX_P1) {
  43 #if CASTFLAGS & 2
  44     if (f < U32_MAX_P1_HALF)
  45       return (I32)(U32) f;
  46     f -= U32_MAX_P1_HALF;
  47     return (I32)(((U32) f) | (1 + U32_MAX >> 1));
  48 #else
  49     return (I32)(U32) f;
  50 #endif
  51   }
  52   return f > 0 ? (I32)U32_MAX : 0 /* NaN */;
  53 }
  54
  55 IV
  56 Perl_cast_iv(pTHX_ NV f)
  57 {
  58   if (f < IV_MAX_P1)
  59     return f < IV_MIN ? IV_MIN : (IV) f;
  60   if (f < UV_MAX_P1) {
  61 #if CASTFLAGS & 2
  62     /* For future flexibility allowing for sizeof(UV) >= sizeof(IV)  */
  63     if (f < UV_MAX_P1_HALF)
  64       return (IV)(UV) f;
  65     f -= UV_MAX_P1_HALF;
  66     return (IV)(((UV) f) | (1 + UV_MAX >> 1));
  67 #else
  68     return (IV)(UV) f;
  69 #endif
  70   }
  71   return f > 0 ? (IV)UV_MAX : 0 /* NaN */;
  72 }
  73
  74 UV
  75 Perl_cast_uv(pTHX_ NV f)
  76 {
  77   if (f < 0.0)
  78     return f < IV_MIN ? (UV) IV_MIN : (UV)(IV) f;
  79   if (f < UV_MAX_P1) {
  80 #if CASTFLAGS & 2
  81     if (f < UV_MAX_P1_HALF)
  82       return (UV) f;
  83     f -= UV_MAX_P1_HALF;
  84     return ((UV) f) | (1 + UV_MAX >> 1);
  85 #else
  86     return (UV) f;
  87 #endif
  88   }
  89   return f > 0 ? UV_MAX : 0 /* NaN */;
  90 }
  91
  92 #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
  93 /*
  94  * This hack is to force load of "huge" support from libm.a
  95  * So it is in perl for (say) POSIX to use.
  96  * Needed for SunOS with Sun's 'acc' for example.
  97  */
  98 NV
  99 Perl_huge(void)
 100 {
 101 #   if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
 102     return HUGE_VALL;
 103 #   endif
 104     return HUGE_VAL;
 105 }
 106 #endif
 107
 108 NV
 109 Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 110 {
 111     register char *s = start;
 112     register NV rnv = 0.0;
 113     register UV ruv = 0;
 114     register bool seenb = FALSE;
 115     register bool overflowed = FALSE;
 116
 117     for (; len-- && *s; s++) {
 118         if (!(*s == '0' || *s == '1')) {
 119             if (*s == '_' && len && *retlen
 120                 && (s[1] == '0' || s[1] == '1'))
 121             {
 122                 --len;
 123                 ++s;
 124             }
 125             else if (seenb == FALSE && *s == 'b' && ruv == 0) {
 126                 /* Disallow 0bbb0b0bbb... */
 127                 seenb = TRUE;
 128                 continue;
 129             }
 130             else {
 131                 if (ckWARN(WARN_DIGIT))
 132                     Perl_warner(aTHX_ WARN_DIGIT,
 133                                 "Illegal binary digit '%c' ignored", *s);
 134                 break;
 135             }
 136         }
 137         if (!overflowed) {
 138             register UV xuv = ruv << 1;
 139
 140             if ((xuv >> 1) != ruv) {
 141                 overflowed = TRUE;
 142                 rnv = (NV) ruv;
 143                 if (ckWARN_d(WARN_OVERFLOW))
 144                     Perl_warner(aTHX_ WARN_OVERFLOW,
 145                                 "Integer overflow in binary number");
 146             }
 147             else
 148                 ruv = xuv | (*s - '0');
 149         }
 150         if (overflowed) {
 151             rnv *= 2;
 152             /* If an NV has not enough bits in its mantissa to
 153              * represent an UV this summing of small low-order numbers
 154              * is a waste of time (because the NV cannot preserve
 155              * the low-order bits anyway): we could just remember when
 156              * did we overflow and in the end just multiply rnv by the
 157              * right amount. */
 158             rnv += (*s - '0');
 159         }
 160     }
 161     if (!overflowed)
 162         rnv = (NV) ruv;
 163     if (   ( overflowed && rnv > 4294967295.0)
 164 #if UVSIZE > 4
 165         || (!overflowed && ruv > 0xffffffff  )
 166 #endif
 167         ) {
 168         if (ckWARN(WARN_PORTABLE))
 169             Perl_warner(aTHX_ WARN_PORTABLE,
 170                         "Binary number > 0b11111111111111111111111111111111 non-portable");
 171     }
 172     *retlen = s - start;
 173     return rnv;
 174 }
 175
 176 NV
 177 Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 178 {
 179     register char *s = start;
 180     register NV rnv = 0.0;
 181     register UV ruv = 0;
 182     register bool overflowed = FALSE;
 183
 184     for (; len-- && *s; s++) {
 185         if (!(*s >= '0' && *s <= '7')) {
 186             if (*s == '_' && len && *retlen
 187                 && (s[1] >= '0' && s[1] <= '7'))
 188             {
 189                 --len;
 190                 ++s;
 191             }
 192             else {
 193                 /* Allow \octal to work the DWIM way (that is, stop scanning
 194                  * as soon as non-octal characters are seen, complain only iff
 195                  * someone seems to want to use the digits eight and nine). */
 196                 if (*s == '8' || *s == '9') {
 197                     if (ckWARN(WARN_DIGIT))
 198                         Perl_warner(aTHX_ WARN_DIGIT,
 199                                     "Illegal octal digit '%c' ignored", *s);
 200                 }
 201                 break;
 202             }
 203         }
 204         if (!overflowed) {
 205             register UV xuv = ruv << 3;
 206
 207             if ((xuv >> 3) != ruv) {
 208                 overflowed = TRUE;
 209                 rnv = (NV) ruv;
 210                 if (ckWARN_d(WARN_OVERFLOW))
 211                     Perl_warner(aTHX_ WARN_OVERFLOW,
 212                                 "Integer overflow in octal number");
 213             }
 214             else
 215                 ruv = xuv | (*s - '0');
 216         }
 217         if (overflowed) {
 218             rnv *= 8.0;
 219             /* If an NV has not enough bits in its mantissa to
 220              * represent an UV this summing of small low-order numbers
 221              * is a waste of time (because the NV cannot preserve
 222              * the low-order bits anyway): we could just remember when
 223              * did we overflow and in the end just multiply rnv by the
 224              * right amount of 8-tuples. */
 225             rnv += (NV)(*s - '0');
 226         }
 227     }
 228     if (!overflowed)
 229         rnv = (NV) ruv;
 230     if (   ( overflowed && rnv > 4294967295.0)
 231 #if UVSIZE > 4
 232         || (!overflowed && ruv > 0xffffffff  )
 233 #endif
 234         ) {
 235         if (ckWARN(WARN_PORTABLE))
 236             Perl_warner(aTHX_ WARN_PORTABLE,
 237                         "Octal number > 037777777777 non-portable");
 238     }
 239     *retlen = s - start;
 240     return rnv;
 241 }
 242
 243 NV
 244 Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 245 {
 246     register char *s = start;
 247     register NV rnv = 0.0;
 248     register UV ruv = 0;
 249     register bool overflowed = FALSE;
 250     char *hexdigit;
 251
 252     if (len > 2) {
 253         if (s[0] == 'x') {
 254             s++;
 255             len--;
 256         }
 257         else if (len > 3 && s[0] == '0' && s[1] == 'x') {
 258             s+=2;
 259             len-=2;
 260         }
 261     }
 262
 263     for (; len-- && *s; s++) {
 264         hexdigit = strchr((char *) PL_hexdigit, *s);
 265         if (!hexdigit) {
 266             if (*s == '_' && len && *retlen && s[1]
 267                 && (hexdigit = strchr((char *) PL_hexdigit, s[1])))
 268             {
 269                 --len;
 270                 ++s;
 271             }
 272             else {
 273                 if (ckWARN(WARN_DIGIT))
 274                     Perl_warner(aTHX_ WARN_DIGIT,
 275                                 "Illegal hexadecimal digit '%c' ignored", *s);
 276                 break;
 277             }
 278         }
 279         if (!overflowed) {
 280             register UV xuv = ruv << 4;
 281
 282             if ((xuv >> 4) != ruv) {
 283                 overflowed = TRUE;
 284                 rnv = (NV) ruv;
 285                 if (ckWARN_d(WARN_OVERFLOW))
 286                     Perl_warner(aTHX_ WARN_OVERFLOW,
 287                                 "Integer overflow in hexadecimal number");
 288             }
 289             else
 290                 ruv = xuv | ((hexdigit - PL_hexdigit) & 15);
 291         }
 292         if (overflowed) {
 293             rnv *= 16.0;
 294             /* If an NV has not enough bits in its mantissa to
 295              * represent an UV this summing of small low-order numbers
 296              * is a waste of time (because the NV cannot preserve
 297              * the low-order bits anyway): we could just remember when
 298              * did we overflow and in the end just multiply rnv by the
 299              * right amount of 16-tuples. */
 300             rnv += (NV)((hexdigit - PL_hexdigit) & 15);
 301         }
 302     }
 303     if (!overflowed)
 304         rnv = (NV) ruv;
 305     if (   ( overflowed && rnv > 4294967295.0)
 306 #if UVSIZE > 4
 307         || (!overflowed && ruv > 0xffffffff  )
 308 #endif
 309         ) {
 310         if (ckWARN(WARN_PORTABLE))
 311             Perl_warner(aTHX_ WARN_PORTABLE,
 312                         "Hexadecimal number > 0xffffffff non-portable");
 313     }
 314     *retlen = s - start;
 315     return rnv;
 316 }
 317
 318 /*
 319 =for apidoc grok_numeric_radix
 320
 321 Scan and skip for a numeric decimal separator (radix).
 322
 323 =cut
 324  */
 325 bool
 326 Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
 327 {
 328 #ifdef USE_LOCALE_NUMERIC
 329     if (PL_numeric_radix_sv && IN_LOCALE) {
 330         STRLEN len;
 331         char* radix = SvPV(PL_numeric_radix_sv, len);
 332         if (*sp + len <= send && memEQ(*sp, radix, len)) {
 333             *sp += len;
 334             return TRUE;
 335         }
 336     }
 337     /* always try "." if numeric radix didn't match because
 338      * we may have data from different locales mixed */
 339 #endif
 340     if (*sp < send && **sp == '.') {
 341         ++*sp;
 342         return TRUE;
 343     }
 344     return FALSE;
 345 }
 346
 347 /*
 348 =for apidoc grok_number
 349
 350 Recognise (or not) a number.  The type of the number is returned
 351 (0 if unrecognised), otherwise it is a bit-ORed combination of
 352 IS_NUMBER_IN_UV, IS_NUMBER_GREATER_THAN_UV_MAX, IS_NUMBER_NOT_INT,
 353 IS_NUMBER_NEG, IS_NUMBER_INFINITY (defined in perl.h).
 354
 355 If the value of the number can fit an in UV, it is returned in the *valuep
 356 IS_NUMBER_IN_UV will be set to indicate that *valuep is valid, IS_NUMBER_IN_UV
 357 will never be set unless *valuep is valid, but *valuep may have been assigned
 358 to during processing even though IS_NUMBER_IN_UV is not set on return.
 359 If valuep is NULL, IS_NUMBER_IN_UV will be set for the same cases as when
 360 valuep is non-NULL, but no actual assignment (or SEGV) will occur.
 361
 362 IS_NUMBER_NOT_INT will be set with IS_NUMBER_IN_UV if trailing decimals were
 363 seen (in which case *valuep gives the true value truncated to an integer), and
 364 IS_NUMBER_NEG if the number is negative (in which case *valuep holds the
 365 absolute value).  IS_NUMBER_IN_UV is not set if e notation was used or the
 366 number is larger than a UV.
 367
 368 =cut
 369  */
 370 int
 371 Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
 372 {
 373   const char *s = pv;
 374   const char *send = pv + len;
 375   const UV max_div_10 = UV_MAX / 10;
 376   const char max_mod_10 = UV_MAX % 10;
 377   int numtype = 0;
 378   int sawinf = 0;
 379
 380   while (s < send && isSPACE(*s))
 381     s++;
 382   if (s == send) {
 383     return 0;
 384   } else if (*s == '-') {
 385     s++;
 386     numtype = IS_NUMBER_NEG;
 387   }
 388   else if (*s == '+')
 389   s++;
 390
 391   if (s == send)
 392     return 0;
 393
 394   /* next must be digit or the radix separator or beginning of infinity */
 395   if (isDIGIT(*s)) {
 396     /* UVs are at least 32 bits, so the first 9 decimal digits cannot
 397        overflow.  */
 398     UV value = *s - '0';
 399     /* This construction seems to be more optimiser friendly.
 400        (without it gcc does the isDIGIT test and the *s - '0' separately)
 401        With it gcc on arm is managing 6 instructions (6 cycles) per digit.
 402        In theory the optimiser could deduce how far to unroll the loop
 403        before checking for overflow.  */
 404     if (++s < send) {
 405       int digit = *s - '0';
 406       if (digit >= 0 && digit <= 9) {
 407         value = value * 10 + digit;
 408         if (++s < send) {
 409           digit = *s - '0';
 410           if (digit >= 0 && digit <= 9) {
 411             value = value * 10 + digit;
 412             if (++s < send) {
 413               digit = *s - '0';
 414               if (digit >= 0 && digit <= 9) {
 415                 value = value * 10 + digit;
 416                 if (++s < send) {
 417                   digit = *s - '0';
 418                   if (digit >= 0 && digit <= 9) {
 419                     value = value * 10 + digit;
 420                     if (++s < send) {
 421                       digit = *s - '0';
 422                       if (digit >= 0 && digit <= 9) {
 423                         value = value * 10 + digit;
 424                         if (++s < send) {
 425                           digit = *s - '0';
 426                           if (digit >= 0 && digit <= 9) {
 427                             value = value * 10 + digit;
 428                             if (++s < send) {
 429                               digit = *s - '0';
 430                               if (digit >= 0 && digit <= 9) {
 431                                 value = value * 10 + digit;
 432                                 if (++s < send) {
 433                                   digit = *s - '0';
 434                                   if (digit >= 0 && digit <= 9) {
 435                                     value = value * 10 + digit;
 436                                     if (++s < send) {
 437                                       /* Now got 9 digits, so need to check
 438                                          each time for overflow.  */
 439                                       digit = *s - '0';
 440                                       while (digit >= 0 && digit <= 9
 441                                              && (value < max_div_10
 442                                                  || (value == max_div_10
 443                                                      && digit <= max_mod_10))) {
 444                                         value = value * 10 + digit;
 445                                         if (++s < send)
 446                                           digit = *s - '0';
 447                                         else
 448                                           break;
 449                                       }
 450                                       if (digit >= 0 && digit <= 9
 451                                           && (s < send)) {
 452                                         /* value overflowed.
 453                                            skip the remaining digits, don't
 454                                            worry about setting *valuep.  */
 455                                         do {
 456                                           s++;
 457                                         } while (s < send && isDIGIT(*s));
 458                                         numtype |=
 459                                           IS_NUMBER_GREATER_THAN_UV_MAX;
 460                                         goto skip_value;
 461                                       }
 462                                     }
 463                                   }
 464                                 }
 465                               }
 466                             }
 467                           }
 468                         }
 469                       }
 470                     }
 471                   }
 472                 }
 473               }
 474             }
 475           }
 476         }
 477       }
 478     }
 479     numtype |= IS_NUMBER_IN_UV;
 480     if (valuep)
 481       *valuep = value;
 482
 483   skip_value:
 484     if (GROK_NUMERIC_RADIX(&s, send)) {
 485       numtype |= IS_NUMBER_NOT_INT;
 486       while (s < send && isDIGIT(*s))  /* optional digits after the radix */
 487         s++;
 488     }
 489   }
 490   else if (GROK_NUMERIC_RADIX(&s, send)) {
 491     numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
 492     /* no digits before the radix means we need digits after it */
 493     if (s < send && isDIGIT(*s)) {
 494       do {
 495         s++;
 496       } while (s < send && isDIGIT(*s));
 497       if (valuep) {
 498         /* integer approximation is valid - it's 0.  */
 499         *valuep = 0;
 500       }
 501     }
 502     else
 503       return 0;
 504   } else if (*s == 'I' || *s == 'i') {
 505     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
 506     s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
 507     s++; if (s < send && (*s == 'I' || *s == 'i')) {
 508       s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
 509       s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
 510       s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
 511       s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
 512       s++;
 513     }
 514     sawinf = 1;
 515   } else /* Add test for NaN here.  */
 516     return 0;
 517
 518   if (sawinf) {
 519     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
 520     numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
 521   } else if (s < send) {
 522     /* we can have an optional exponent part */
 523     if (*s == 'e' || *s == 'E') {
 524       /* The only flag we keep is sign.  Blow away any "it's UV"  */
 525       numtype &= IS_NUMBER_NEG;
 526       numtype |= IS_NUMBER_NOT_INT;
 527       s++;
 528       if (s < send && (*s == '-' || *s == '+'))
 529         s++;
 530       if (s < send && isDIGIT(*s)) {
 531         do {
 532           s++;
 533         } while (s < send && isDIGIT(*s));
 534       }
 535       else
 536       return 0;
 537     }
 538   }
 539   while (s < send && isSPACE(*s))
 540     s++;
 541   if (s >= send)
 542   return numtype;
 543   if (len == 10 && memEQ(pv, "0 but true", 10)) {
 544     if (valuep)
 545       *valuep = 0;
 546     return IS_NUMBER_IN_UV;
 547   }
 548   return 0;
 549 }
 550
 551 NV
 552 S_mulexp10(NV value, I32 exponent)
 553 {
 554     NV result = 1.0;
 555     NV power = 10.0;
 556     bool negative = 0;
 557     I32 bit;
 558
 559     if (exponent == 0)
 560         return value;
 561     else if (exponent < 0) {
 562         negative = 1;
 563         exponent = -exponent;
 564     }
 565 #ifdef __VAX /* avoid %SYSTEM-F-FLTOVF_F sans VAXC$ESTABLISH */
 566 #  if defined(__DECC_VER) && __DECC_VER <= 50390006
 567     /* __F_FLT_MAX_10_EXP - 5 == 33 */
 568     if (!negative &&
 569           (log10(value) + exponent) >= (__F_FLT_MAX_10_EXP - 5))
 570         return NV_MAX;
 571 #  endif
 572 #endif
 573     for (bit = 1; exponent; bit <<= 1) {
 574         if (exponent & bit) {
 575             exponent ^= bit;
 576             result *= power;
 577         }
 578         power *= power;
 579     }
 580     return negative ? value / result : value * result;
 581 }
 582
 583 NV
 584 Perl_my_atof(pTHX_ const char* s)
 585 {
 586     NV x = 0.0;
 587 #ifdef USE_LOCALE_NUMERIC
 588     if (PL_numeric_local && IN_LOCALE) {
 589         NV y;
 590
 591         /* Scan the number twice; once using locale and once without;
 592          * choose the larger result (in absolute value). */
 593         Perl_atof2(aTHX_ s, &x);
 594         SET_NUMERIC_STANDARD();
 595         Perl_atof2(aTHX_ s, &y);
 596         SET_NUMERIC_LOCAL();
 597         if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
 598             return y;
 599     }
 600     else
 601         Perl_atof2(aTHX_ s, &x);
 602 #else
 603     Perl_atof2(aTHX_ s, &x);
 604 #endif
 605     return x;
 606 }
 607
 608 char*
 609 Perl_my_atof2(pTHX_ const char* orig, NV* value)
 610 {
 611     NV result = 0.0;
 612     bool negative = 0;
 613     char* s = (char*)orig;
 614     char* send = s + strlen(orig) - 1;
 615     bool seendigit = 0;
 616     I32 expextra = 0;
 617     I32 exponent = 0;
 618     I32 i;
 619 /* this is arbitrary */
 620 #define PARTLIM 6
 621 /* we want the largest integers we can usefully use */
 622 #if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
 623 #   define PARTSIZE ((int)TYPE_DIGITS(U64)-1)
 624     U64 part[PARTLIM];
 625 #else
 626 #   define PARTSIZE ((int)TYPE_DIGITS(U32)-1)
 627     U32 part[PARTLIM];
 628 #endif
 629     I32 ipart = 0;      /* index into part[] */
 630     I32 offcount;       /* number of digits in least significant part */
 631
 632     /* leading whitespace */
 633     while (isSPACE(*s))
 634         ++s;
 635
 636     /* sign */
 637     switch (*s) {
 638         case '-':
 639             negative = 1;
 640             /* fall through */
 641         case '+':
 642             ++s;
 643     }
 644
 645     part[0] = offcount = 0;
 646     if (isDIGIT(*s)) {
 647         seendigit = 1;  /* get this over with */
 648
 649         /* skip leading zeros */
 650         while (*s == '0')
 651             ++s;
 652     }
 653
 654     /* integer digits */
 655     while (isDIGIT(*s)) {
 656         if (++offcount > PARTSIZE) {
 657             if (++ipart < PARTLIM) {
 658                 part[ipart] = 0;
 659                 offcount = 1;   /* ++0 */
 660             }
 661             else {
 662                 /* limits of precision reached */
 663                 --ipart;
 664                 --offcount;
 665                 if (*s >= '5')
 666                     ++part[ipart];
 667                 while (isDIGIT(*s)) {
 668                     ++expextra;
 669                     ++s;
 670                 }
 671                 /* warn of loss of precision? */
 672                 break;
 673             }
 674         }
 675         part[ipart] = part[ipart] * 10 + (*s++ - '0');
 676     }
 677
 678     /* decimal point */
 679     if (GROK_NUMERIC_RADIX((const char **)&s, send)) {
 680         if (isDIGIT(*s))
 681             seendigit = 1;      /* get this over with */
 682
 683         /* decimal digits */
 684         while (isDIGIT(*s)) {
 685             if (++offcount > PARTSIZE) {
 686                 if (++ipart < PARTLIM) {
 687                     part[ipart] = 0;
 688                     offcount = 1;       /* ++0 */
 689                 }
 690                 else {
 691                     /* limits of precision reached */
 692                     --ipart;
 693                     --offcount;
 694                     if (*s >= '5')
 695                         ++part[ipart];
 696                     while (isDIGIT(*s))
 697                         ++s;
 698                     /* warn of loss of precision? */
 699                     break;
 700                 }
 701             }
 702             --expextra;
 703             part[ipart] = part[ipart] * 10 + (*s++ - '0');
 704         }
 705     }
 706
 707     /* combine components of mantissa */
 708     for (i = 0; i <= ipart; ++i)
 709         result += S_mulexp10((NV)part[ipart - i],
 710                 i ? offcount + (i - 1) * PARTSIZE : 0);
 711
 712     if (seendigit && (*s == 'e' || *s == 'E')) {
 713         bool expnegative = 0;
 714
 715         ++s;
 716         switch (*s) {
 717             case '-':
 718                 expnegative = 1;
 719                 /* fall through */
 720             case '+':
 721                 ++s;
 722         }
 723         while (isDIGIT(*s))
 724             exponent = exponent * 10 + (*s++ - '0');
 725         if (expnegative)
 726             exponent = -exponent;
 727     }
 728
 729     /* now apply the exponent */
 730     exponent += expextra;
 731     result = S_mulexp10(result, exponent);
 732
 733     /* now apply the sign */
 734     if (negative)
 735         result = -result;
 736     *value = result;
 737     return s;
 738 }
 739