diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2015-02-11 08:49:27 -0500 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2015-02-11 08:49:27 -0500 |
commit | 3823048b64b018d16e9a9cc16add1847fe60e6bd (patch) | |
tree | 56b0b59dc0f1320cdb90bcf68e1c45a76acc43df /numeric.c | |
parent | 4258cf903c752ec19a3aeee9b93020533d923e1a (diff) | |
download | perl-3823048b64b018d16e9a9cc16add1847fe60e6bd.tar.gz |
infnan: revert nan payload/signaling changes
4258cf903c752ec19a3aeee9b93020533d923e1a
91e945c051cfcdf499d5b43aa5ac0a5681cdd595
eb254f2672a985ec3c34810f624f36c18fc35fc7
c9a671b17a9c588469bcef958038daaaaf9cc88b
99fcdd4df47515fb0a62a046e622adec0871754d
ba511db061a88439acb528a66c780ab574bb4fb0
0d1cf11425608e9be019f27a3a4575bc71c49e6b
c2ea8a88f8537d00ba25ec8feb63ef5dc085ef2b
b5a6eedc2f49a90089cca896ee20f41e373fb4c9
30419b527d2c5a06cefe2db9183f59e2697c47fc
29b62199cd4c359dfc6b9d690341de40d105ca5f
be181dc9d91c84a2fe03912c993c8259fed92641
4de1bcfe1abdaba0a5da394ddea0cc6fd7e36c7b
6e915616c4ccb4f6cc3122c5d395765db96c0a2d
b2e3501558a1017eb529be0915c25d31671e7869
bfaa02d55f4ace1571e6fa9e5b47d5e3ac3cecc6
569f27e562618bdddcf4a9fc71612283a73747e9
4f89311dc8de87ddc9a302c6f2d2c844951bbd28
a307a0b0d83c509cc2adaad8cebb44260294bf36
6640aa2c3b93d7ac78e4e86983fe5948b3ca55f2
b74dc0b3c96390d8bf83d8c3ffc0c2c2d1f0a5d3
c3a8e5a5b4bb89a15de642c023dfd5cbc4678938
Diffstat (limited to 'numeric.c')
-rw-r--r-- | numeric.c | 692 |
1 files changed, 161 insertions, 531 deletions
@@ -547,491 +547,6 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) return FALSE; } -#if 0 -/* For debugging. */ -static void -S_hexdump_nv(NV nv) -{ - int i; - /* Remember that NVSIZE may include garbage bytes, the most - * notable case being the x86 80-bit extended precision long doubles, - * which have 6 or 2 unused bytes (NVSIZE = 16 or NVSIZE = 12). */ - for (i = 0; i < NVSIZE; i++) { - PerlIO_printf(Perl_debug_log, "%02x ", ((U8*)&nv)[i]); - } - PerlIO_printf(Perl_debug_log, "\n"); -} -#endif - -/* -=for apidoc nan_hibyte - -Given an NV, returns pointer to the byte containing the most -significant bit of the NaN, this bit is most commonly the -quiet/signaling bit of the NaN. The mask will contain a mask -appropriate for manipulating the most significant bit. -Note that this bit may not be the highest bit of the byte. - -If the NV is not a NaN, returns NULL. - -Most platforms have "high bit is one" -> quiet nan. -The known opposite exceptions are older MIPS and HPPA platforms. - -Some platforms do not differentiate between quiet and signaling NaNs. - -=cut -*/ -U8* -Perl_nan_hibyte(NV *nvp, U8* mask) -{ - STRLEN i = (NV_MANT_REAL_DIG - 1) / 8; - - PERL_ARGS_ASSERT_NAN_HIBYTE; - -#if defined(USE_LONG_DOUBLE) && (LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN) - /* See the definition of NV_NAN_BITS. */ - *mask = 1 << 6; -#else - { - STRLEN j = (NV_MANT_REAL_DIG - 1) % 8; - *mask = 1 << j; - } -#endif -#ifdef NV_BIG_ENDIAN - return (U8*) nvp + NVSIZE - 1 - i; -#endif -#ifdef NV_LITTLE_ENDIAN - return (U8*) nvp + i; -#endif -} - -/* -=for apidoc nan_signaling_set - -Set or unset the NaN signaling-ness. - -Of those platforms that differentiate between quiet and signaling -platforms the majority has the semantics of the most significant bit -being on meaning quiet NaN, so for signaling we need to clear the bit. - -Some platforms (older MIPS, and HPPA) have the opposite -semantics, and we set the bit for a signaling NaN. - -=cut -*/ -void -Perl_nan_signaling_set(pTHX_ NV *nvp, bool signaling) -{ - U8 mask; - U8* hibyte; - - PERL_ARGS_ASSERT_NAN_SIGNALING_SET; - - hibyte = nan_hibyte(nvp, &mask); - if (hibyte) { - const NV nan = NV_NAN; - /* Decent optimizers should make the irrelevant branch to disappear. - * XXX Configure scan */ - if ((((U8*)&nan)[hibyte - (U8*)nvp] & mask)) { - /* x86 style: the most significant bit of the NaN is off - * for a signaling NaN, and on for a quiet NaN. */ - if (signaling) { - *hibyte &= ~mask; - } else { - *hibyte |= mask; - } - } else { - /* MIPS/HPPA style: the most significant bit of the NaN is on - * for a signaling NaN, and off for a quiet NaN. */ - if (signaling) { - *hibyte |= mask; - } else { - *hibyte &= ~mask; - } - } - } -} - -/* -=for apidoc nan_is_signaling - -Returns true if the nv is a NaN is a signaling NaN. - -=cut -*/ -int -Perl_nan_is_signaling(NV nv) -{ - /* Quiet NaN bit pattern (64-bit doubles, ignore endianness): - * x86 00 00 00 00 00 00 f8 7f - * sparc 7f ff ff ff ff ff ff ff - * mips 7f f7 ff ff ff ff ff ff - * hppa 7f f4 00 00 00 00 00 00 - * The "7ff" is the exponent. The most significant bit of the NaN - * (note: here, not the most significant bit of the byte) is of - * interest: in the x86 style (also in sparc) the bit on means - * 'quiet', in the mips/hppa style the bit off means 'quiet'. */ -#ifdef Perl_fp_classify_snan - return Perl_fp_classify_snan(nv); -#else - if (Perl_isnan(nv)) { - U8 mask; - U8 *hibyte = nan_hibyte(&nv, &mask); - if (hibyte) { - /* Hoping NV_NAN is a quiet nan - this might be a false hope. - * XXX Configure test */ - const NV nan = NV_NAN; - return (*hibyte & mask) != (((U8*)&nan)[hibyte - (U8*)&nv] & mask); - } - } - return 0; -#endif -} - -/* The largest known floating point numbers are the IEEE quadruple - * precision of 128 bits. */ -#define MAX_NV_BYTES (128/8) - -/* - -=for apidoc nan_payload_set - -Set the NaN payload of the nv. - -The first byte is the highest order byte of the payload (big-endian). - -The signaling flag, if true, turns the generated NaN into a signaling one. -In most platforms this means turning _off_ the most significant bit of the -NaN. Note the _most_ - some platforms have the opposite semantics. -Do not assume any portability of the NaN semantics. - -=cut -*/ -void -Perl_nan_payload_set(pTHX_ NV *nvp, SV* svp, const void *bytes, STRLEN byten, bool signaling) -{ - /* How many bits we can set in the payload. - * - * Note that whether the most signicant bit is a quiet or - * signaling NaN is actually unstandardized. Most platforms use - * it as the 'quiet' bit. The known exceptions to this are older - * MIPS, and HPPA. - * - * Yet another unstandardized area is what does the difference - * actually mean - if it exists: some platforms do not even have - * signaling NaNs. - * - * C99 nan() is supposed to generate quiet NaNs. */ - int bits = NV_NAN_BITS; - U8 mask; - U8* hibyte; - U8 hibit; - - STRLEN i, nvi; - bool overflow = FALSE; - - /* XXX None of this works for doubledouble platforms, or for mixendians. */ - - PERL_ARGS_ASSERT_NAN_PAYLOAD_SET; - - *nvp = NV_NAN; - hibyte = nan_hibyte(nvp, &mask); - hibit = *hibyte & mask; - -#ifdef NV_BIG_ENDIAN - nvi = NVSIZE - 1; -#endif -#ifdef NV_LITTLE_ENDIAN - nvi = 0; -#endif - - if (byten > MAX_NV_BYTES) { - byten = MAX_NV_BYTES; - overflow = TRUE; - } - for (i = 0; bits > 0; i++) { - U8 b = i < byten ? ((U8*) bytes)[i] : 0; - if (bits > 0 && bits < 8) { - U8 m = (1 << bits) - 1; - ((U8*)nvp)[nvi] &= ~m; - ((U8*)nvp)[nvi] |= b & m; - bits = 0; - } else { - ((U8*)nvp)[nvi] = b; - bits -= 8; - } -#ifdef NV_BIG_ENDIAN - nvi--; -#endif -#ifdef NV_LITTLE_ENDIAN - nvi++; -#endif - } - if (hibit) { - *hibyte |= mask; - } else { - *hibyte &= ~mask; - } - if (overflow) { - if (svp) { - sv_setpvf(svp, "NaN payload overflowed %d bits", NV_NAN_BITS); - } - } - nan_signaling_set(nvp, signaling); -} - -/* -=for apidoc grok_nan_payload - -Helper for grok_nan(). - -Parses the "..." in C99-style "nan(...)" strings, and sets the nvp accordingly. - -If you want the parse the "nan" part you need to use grok_nan(). - -=cut -*/ -const char * -Perl_grok_nan_payload(pTHX_ const char* s, const char* send, bool signaling, int *flags, NV* nvp, SV* svp) -{ - U8 bytes[MAX_NV_BYTES]; - STRLEN byten = 0; - const char *t = send - 1; /* minus one for ')' */ - bool overflow = FALSE; - bool bogus = FALSE; - const char *orig = s; - - PERL_ARGS_ASSERT_GROK_NAN_PAYLOAD; - - /* XXX: legacy nan payload formats like "nan123", - * "nan0xabc", or "nan(s123)" ("s" for signaling). */ - - while (t > s && isSPACE(*t)) t--; - - if (*t != ')') { - U8 bytes[1] = { 0 }; - nan_payload_set(nvp, svp, bytes, 1, signaling); - return t; - } - - if (++s == send) { - *flags |= IS_NUMBER_TRAILING; - return s; - } - - while (s < t && byten < MAX_NV_BYTES) { - UV uv; - int nantype = 0; - - if (s[0] == '0' && s + 2 < t && - isALPHA_FOLD_EQ(s[1], 'x') && - isXDIGIT(s[2])) { - const char *u = s + 3; - STRLEN len; - I32 uvflags; - - while (isXDIGIT(*u)) u++; - len = u - s; - uvflags = PERL_SCAN_ALLOW_UNDERSCORES; - uv = grok_hex(s, &len, &uvflags, NULL); - if ((uvflags & PERL_SCAN_GREATER_THAN_UV_MAX)) { - nantype = 0; - } else { - nantype = IS_NUMBER_IN_UV; - } - s += len; - } else if (s[0] == '0' && s + 2 < t && - isALPHA_FOLD_EQ(s[1], 'b') && - (s[2] == '0' || s[2] == '1')) { - const char *u = s + 3; - STRLEN len; - I32 uvflags; - - while (*u == '0' || *u == '1') u++; - len = u - s; - uvflags = PERL_SCAN_ALLOW_UNDERSCORES; - uv = grok_bin(s, &len, &uvflags, NULL); - if ((uvflags & PERL_SCAN_GREATER_THAN_UV_MAX)) { - nantype = 0; - } else { - nantype = IS_NUMBER_IN_UV; - } - s += len; - } else if ((s[0] == '\'' || s[0] == '"') && - s + 2 < t && t[-1] == s[0]) { - /* Perl extension: if the input looks like a string - * constant ('' or ""), read its bytes as-they-come. */ - STRLEN n = t - s - 2; - STRLEN i; - if ((n > MAX_NV_BYTES - byten) || - (n * 8 > NV_MANT_REAL_DIG)) { - overflow = TRUE; - break; - } - /* Copy the bytes in reverse so that \x41\x42 ('AB') - * is equivalent to 0x4142. In other words, the bytes - * are in big-endian order. */ - for (i = 0; i < n; i++) { - bytes[n - i - 1] = s[i + 1]; - } - byten += n; - break; - } else if (s < t && (isDIGIT(*s) || *s == '-' || *s == '+')) { - const char *u; - nantype = - grok_number_flags(s, (STRLEN)(t - s), &uv, - PERL_SCAN_TRAILING | - PERL_SCAN_ALLOW_UNDERSCORES); - /* Unfortunately grok_number_flags() doesn't - * tell how far we got and the ')' will always - * be "trailing", so we need to double-check - * whether we had something dubious. */ - u = s; - if ((*u == '-' || *u == '+')) { - u++; - } - for (; u < t; u++) { - if (!isDIGIT(*u)) { - *flags |= IS_NUMBER_TRAILING; - break; - } - } - if ((nantype & IS_NUMBER_NEG)) { - uv = (UV) (-uv); - } - s = u; - } else { - bogus = TRUE; - break; - } - /* XXX Doesn't do octal: nan("0123"). - * Probably not a big loss. */ - - if (!(nantype & IS_NUMBER_IN_UV)) { - overflow = TRUE; - break; - } - - if (uv) { - int bits = NV_NAN_BITS; - while (uv && byten < MAX_NV_BYTES && bits > 0) { - bytes[byten++] = (U8) (uv & 0xFF); - uv >>= 8; - bits -= 8; - } - } - if (uv) { - overflow = TRUE; - } - } - - if (byten == 0) { - bytes[byten++] = 0; - } - - if (svp) { - if (bogus) { - sv_setpvf(svp, "NaN payload \"%s\" invalid",orig); - } else if (overflow) { - sv_setpvf(svp, "NaN payload \"%s\" overflowed %d bits", - orig, NV_NAN_BITS); - } - } - - if (s == send) { - *flags |= IS_NUMBER_TRAILING; - return s; - } - - if (nvp) { - nan_payload_set(nvp, svp, bytes, byten, signaling); - } - - return s; -} - -/* -=for apidoc grok_nan - -Helper for grok_infnan(). - -Parses the C99-style "nan(...)" strings, and sets the nvp accordingly. - -*sp points to the beginning of "nan", which can be also "qnan", "nanq", -or "snan", "nans", and case is ignored. - -The "..." is parsed with grok_nan_payload(). - -=cut -*/ -const char * -Perl_grok_nan(pTHX_ const char* s, const char* send, int *flags, NV* nvp, SV* svp) -{ - bool signaling = FALSE; - - PERL_ARGS_ASSERT_GROK_NAN; - - if (isALPHA_FOLD_EQ(*s, 'S')) { - signaling = TRUE; - s++; if (s == send) return s; - } else if (isALPHA_FOLD_EQ(*s, 'Q')) { - s++; if (s == send) return s; - } - - if (isALPHA_FOLD_EQ(*s, 'N')) { - s++; if (s == send || isALPHA_FOLD_NE(*s, 'A')) return s; - s++; if (s == send || isALPHA_FOLD_NE(*s, 'N')) return s; - s++; - - *flags |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; - - /* NaN can be followed by various stuff (NaNQ, NaNS), while - * some legacy implementations have weird stuff like "NaN%" - * (no idea what that means). */ - if (isALPHA_FOLD_EQ(*s, 's')) { - signaling = TRUE; - s++; - } else if (isALPHA_FOLD_EQ(*s, 'q')) { - s++; - } - - if (*s == '(') { - const char *n = grok_nan_payload(s, send, signaling, flags, nvp, svp); - if (n == send) return NULL; - s = n; - if (*s != ')') { - *flags |= IS_NUMBER_TRAILING; - return s; - } - } else { - if (nvp) { - U8 bytes[1] = { 0 }; - nan_payload_set(nvp, svp, bytes, 1, signaling); - } - - while (s < send && isSPACE(*s)) s++; - - if (s < send && *s) { - /* Note that we here implicitly accept (parse as - * "nan", but with warnings) also any other weird - * trailing stuff for "nan". In the above we just - * check that if we got the C99-style "nan(...)", - * the "..." looks sane. If in future we accept - * more ways of specifying the nan payload (like - * "nan123" or "nan0xabc"), the accepting would - * happen around here. */ - *flags |= IS_NUMBER_TRAILING; - } - } - - s = send; - } - else - return NULL; - - return s; -} - /* =for apidoc grok_infnan @@ -1054,7 +569,7 @@ zero is returned, and the *sp will not move. */ int -Perl_grok_infnan(pTHX_ const char** sp, const char* send, NV* nvp) +Perl_grok_infnan(pTHX_ const char** sp, const char* send) { const char* s = *sp; int flags = 0; @@ -1062,12 +577,6 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send, NV* nvp) PERL_ARGS_ASSERT_GROK_INFNAN; - /* XXX there are further legacy formats like HP-UX "++" for Inf - * and "--" for -Inf. While we might be able to grok those in - * string numification, having those in source code might open - * up too much golfing: ++++; - */ - if (*s == '+') { s++; if (s == send) return 0; } @@ -1116,16 +625,10 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send, NV* nvp) flags |= IS_NUMBER_TRAILING; } flags |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; - if (nvp) { - *nvp = (flags & IS_NUMBER_NEG) ? -NV_INF: NV_INF; - } } else if (isALPHA_FOLD_EQ(*s, 'D') && odh) { /* 1.#IND */ s++; flags |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; - if (nvp) { - *nvp = NV_NAN; - } while (*s == '0') { /* 1.#IND00 */ s++; } @@ -1137,9 +640,158 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send, NV* nvp) } else { /* Maybe NAN of some sort */ - const char *n = grok_nan(s, send, &flags, nvp, NULL); - if (n == NULL) return 0; - s = n; + + if (isALPHA_FOLD_EQ(*s, 'S') || isALPHA_FOLD_EQ(*s, 'Q')) { + /* snan, qNaN */ + /* XXX do something with the snan/qnan difference */ + s++; if (s == send) return 0; + } + + if (isALPHA_FOLD_EQ(*s, 'N')) { + s++; if (s == send || isALPHA_FOLD_NE(*s, 'A')) return 0; + s++; if (s == send || isALPHA_FOLD_NE(*s, 'N')) return 0; + s++; + + flags |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; + + /* NaN can be followed by various stuff (NaNQ, NaNS), but + * there are also multiple different NaN values, and some + * implementations output the "payload" values, + * e.g. NaN123, NAN(abc), while some legacy implementations + * have weird stuff like NaN%. */ + if (isALPHA_FOLD_EQ(*s, 'q') || + isALPHA_FOLD_EQ(*s, 's')) { + /* "nanq" or "nans" are ok, though generating + * these portably is tricky. */ + s++; + } + if (*s == '(') { + /* C99 style "nan(123)" or Perlish equivalent "nan($uv)". */ + const char *t; + s++; + if (s == send) { + return flags | IS_NUMBER_TRAILING; + } + t = s + 1; + while (t < send && *t && *t != ')') { + t++; + } + if (t == send) { + return flags | IS_NUMBER_TRAILING; + } + if (*t == ')') { + int nantype; + UV nanval; + if (s[0] == '0' && s + 2 < t && + isALPHA_FOLD_EQ(s[1], 'x') && + isXDIGIT(s[2])) { + STRLEN len = t - s; + I32 flags = PERL_SCAN_ALLOW_UNDERSCORES; + nanval = grok_hex(s, &len, &flags, NULL); + if ((flags & PERL_SCAN_GREATER_THAN_UV_MAX)) { + nantype = 0; + } else { + nantype = IS_NUMBER_IN_UV; + } + s += len; + } else if (s[0] == '0' && s + 2 < t && + isALPHA_FOLD_EQ(s[1], 'b') && + (s[2] == '0' || s[2] == '1')) { + STRLEN len = t - s; + I32 flags = PERL_SCAN_ALLOW_UNDERSCORES; + nanval = grok_bin(s, &len, &flags, NULL); + if ((flags & PERL_SCAN_GREATER_THAN_UV_MAX)) { + nantype = 0; + } else { + nantype = IS_NUMBER_IN_UV; + } + s += len; + } else { + const char *u; + nantype = + grok_number_flags(s, t - s, &nanval, + PERL_SCAN_TRAILING | + PERL_SCAN_ALLOW_UNDERSCORES); + /* Unfortunately grok_number_flags() doesn't + * tell how far we got and the ')' will always + * be "trailing", so we need to double-check + * whether we had something dubious. */ + for (u = s; u < t; u++) { + if (!isDIGIT(*u)) { + flags |= IS_NUMBER_TRAILING; + break; + } + } + s = u; + } + + /* XXX Doesn't do octal: nan("0123"). + * Probably not a big loss. */ + + if ((nantype & IS_NUMBER_NOT_INT) || + !(nantype && IS_NUMBER_IN_UV)) { + /* XXX the nanval is currently unused, that is, + * not inserted as the NaN payload of the NV. + * But the above code already parses the C99 + * nan(...) format. See below, and see also + * the nan() in POSIX.xs. + * + * Certain configuration combinations where + * NVSIZE is greater than UVSIZE mean that + * a single UV cannot contain all the possible + * NaN payload bits. There would need to be + * some more generic syntax than "nan($uv)". + * + * Issues to keep in mind: + * + * (1) In most common cases there would + * not be an integral number of bytes that + * could be set, only a certain number of bits. + * For example for the common case of + * NVSIZE == UVSIZE == 8 there is room for 52 + * bits in the payload, but the most significant + * bit is commonly reserved for the + * signaling/quiet bit, leaving 51 bits. + * Furthermore, the C99 nan() is supposed + * to generate quiet NaNs, so it is doubtful + * whether it should be able to generate + * signaling NaNs. For the x86 80-bit doubles + * (if building a long double Perl) there would + * be 62 bits (s/q bit being the 63rd). + * + * (2) Endianness of the payload bits. If the + * payload is specified as an UV, the low-order + * bits of the UV are naturally little-endianed + * (rightmost) bits of the payload. The endianness + * of UVs and NVs can be different. */ + return 0; + } + if (s < t) { + flags |= IS_NUMBER_TRAILING; + } + } else { + /* Looked like nan(...), but no close paren. */ + flags |= IS_NUMBER_TRAILING; + } + } else { + while (s < send && isSPACE(*s)) + s++; + if (s < send && *s) { + /* Note that we here implicitly accept (parse as + * "nan", but with warnings) also any other weird + * trailing stuff for "nan". In the above we just + * check that if we got the C99-style "nan(...)", + * the "..." looks sane. + * If in future we accept more ways of specifying + * the nan payload, the accepting would happen around + * here. */ + flags |= IS_NUMBER_TRAILING; + } + } + s = send; + } + else + return 0; } while (s < send && isSPACE(*s)) @@ -1150,7 +802,7 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send, NV* nvp) } /* -=for apidoc grok_number2_flags +=for apidoc grok_number_flags Recognise (or not) a number. The type of the number is returned (0 if unrecognised), otherwise it is a bit-ORed combination of @@ -1164,9 +816,6 @@ to during processing even though IS_NUMBER_IN_UV is not set on return. If valuep is NULL, IS_NUMBER_IN_UV will be set for the same cases as when valuep is non-NULL, but no actual assignment (or SEGV) will occur. -The nvp is used to directly set the value for infinities (Inf) and -not-a-numbers (NaN). - IS_NUMBER_NOT_INT will be set with IS_NUMBER_IN_UV if trailing decimals were seen (in which case *valuep gives the true value truncated to an integer), and IS_NUMBER_NEG if the number is negative (in which case *valuep holds the @@ -1177,10 +826,6 @@ C<flags> allows only C<PERL_SCAN_TRAILING>, which allows for trailing non-numeric text on an otherwise successful I<grok>, setting C<IS_NUMBER_TRAILING> on the result. -=for apidoc grok_number_flags - -Identical to grok_number2_flags() with nvp and flags set to zero. - =for apidoc grok_number Identical to grok_number_flags() with flags set to zero. @@ -1195,26 +840,18 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) return grok_number_flags(pv, len, valuep, 0); } -int -Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags) -{ - PERL_ARGS_ASSERT_GROK_NUMBER_FLAGS; - - return grok_number2_flags(pv, len, valuep, NULL, flags); -} - static const UV uv_max_div_10 = UV_MAX / 10; static const U8 uv_max_mod_10 = UV_MAX % 10; int -Perl_grok_number2_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, NV *nvp, U32 flags) +Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags) { const char *s = pv; const char * const send = pv + len; const char *d; int numtype = 0; - PERL_ARGS_ASSERT_GROK_NUMBER2_FLAGS; + PERL_ARGS_ASSERT_GROK_NUMBER_FLAGS; while (s < send && isSPACE(*s)) s++; @@ -1380,18 +1017,11 @@ Perl_grok_number2_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, NV *nvp, U if ((s + 2 < send) && strchr("inqs#", toFOLD(*s))) { /* Really detect inf/nan. Start at d, not s, since the above * code might have already consumed the "1." or "1". */ - NV nanv; - int infnan = Perl_grok_infnan(aTHX_ &d, send, &nanv); + int infnan = Perl_grok_infnan(aTHX_ &d, send); if ((infnan & IS_NUMBER_INFINITY)) { - if (nvp) { - *nvp = (numtype & IS_NUMBER_NEG) ? -NV_INF : NV_INF; - } return (numtype | infnan); /* Keep sign for infinity. */ } else if ((infnan & IS_NUMBER_NAN)) { - if (nvp) { - *nvp = nanv; - } return (numtype | infnan) & ~IS_NUMBER_NEG; /* Clear sign for nan. */ } } @@ -1639,18 +1269,18 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value { const char *p0 = negative ? s - 1 : s; const char *p = p0; - int infnan = grok_infnan(&p, send, value); + int infnan = grok_infnan(&p, send); if (infnan && p != p0) { /* If we can generate inf/nan directly, let's do so. */ #ifdef NV_INF if ((infnan & IS_NUMBER_INFINITY)) { - /* grok_infnan() already set the value. */ + *value = (infnan & IS_NUMBER_NEG) ? -NV_INF: NV_INF; return (char*)p; } #endif #ifdef NV_NAN if ((infnan & IS_NUMBER_NAN)) { - /* grok_infnan() already set the value. */ + *value = NV_NAN; return (char*)p; } #endif @@ -1952,7 +1582,7 @@ Perl_isinfnansv(pTHX_ SV *sv) { STRLEN len; const char *s = SvPV_nomg_const(sv, len); - return cBOOL(grok_infnan(&s, s+len, NULL)); + return cBOOL(grok_infnan(&s, s+len)); } } |