if (f < U32_MAX_P1_HALF)
return (U32) f;
f -= U32_MAX_P1_HALF;
- return ((U32) f) | (1 + U32_MAX >> 1);
+ return ((U32) f) | (1 + (U32_MAX >> 1));
#else
return (U32) f;
#endif
if (f < U32_MAX_P1_HALF)
return (I32)(U32) f;
f -= U32_MAX_P1_HALF;
- return (I32)(((U32) f) | (1 + U32_MAX >> 1));
+ return (I32)(((U32) f) | (1 + (U32_MAX >> 1)));
#else
return (I32)(U32) f;
#endif
if (f < UV_MAX_P1_HALF)
return (IV)(UV) f;
f -= UV_MAX_P1_HALF;
- return (IV)(((UV) f) | (1 + UV_MAX >> 1));
+ return (IV)(((UV) f) | (1 + (UV_MAX >> 1)));
#else
return (IV)(UV) f;
#endif
if (f < UV_MAX_P1_HALF)
return (UV) f;
f -= UV_MAX_P1_HALF;
- return ((UV) f) | (1 + UV_MAX >> 1);
+ return ((UV) f) | (1 + (UV_MAX >> 1));
#else
return (UV) f;
#endif
converts a string representing a binary number to numeric form.
-On entry I<start> and I<*len> give the string to scan, I<*flags> gives
-conversion flags, and I<result> should be NULL or a pointer to an NV.
+On entry C<start> and C<*len> give the string to scan, C<*flags> gives
+conversion flags, and C<result> should be C<NULL> or a pointer to an NV.
The scan stops at the end of the string, or the first invalid character.
-Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in I<*flags>, encountering an
+Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in C<*flags>, encountering an
invalid character will also trigger a warning.
-On return I<*len> is set to the length of the scanned string,
-and I<*flags> gives output flags.
+On return C<*len> is set to the length of the scanned string,
+and C<*flags> gives output flags.
If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
-and nothing is written to I<*result>. If the value is > UV_MAX C<grok_bin>
-returns
UV_MAX, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
-and writes the value to I<*result> (or the value is discarded if I<result>
+and nothing is written to C<*result>. If the value is > C<UV_MAX>, C<grok_bin>
+returns
C<UV_MAX>, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
+and writes the value to C<*result> (or the value is discarded if C<result>
is NULL).
-The binary number may optionally be prefixed with "0b" or "b" unless
-C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry. If
-C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the binary
-number may use '_' characters to separate digits.
+The binary number may optionally be prefixed with C<"0b"> or C<"b"> unless
+C<PERL_SCAN_DISALLOW_PREFIX> is set in C<*flags> on entry. If
+C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then the binary
+number may use C<"_"> characters to separate digits.
=cut
converts a string representing a hex number to numeric form.
-On entry I<start> and I<*len_p> give the string to scan, I<*flags> gives
-conversion flags, and I<result> should be NULL or a pointer to an NV.
+On entry C<start> and C<*len_p> give the string to scan, C<*flags> gives
+conversion flags, and C<result> should be C<NULL> or a pointer to an NV.
The scan stops at the end of the string, or the first invalid character.
-Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in I<*flags>, encountering an
+Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in C<*flags>, encountering an
invalid character will also trigger a warning.
-On return I<*len> is set to the length of the scanned string,
-and I<*flags> gives output flags.
+On return C<*len> is set to the length of the scanned string,
+and C<*flags> gives output flags.
-If the value is <= UV_MAX it is returned as a UV, the output flags are clear,
-and nothing is written to I<*result>. If the value is > UV_MAX C<grok_hex>
-returns
UV_MAX, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
-and writes the value to I<*result> (or the value is discarded if I<result>
-is NULL).
+If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
+and nothing is written to C<*result>. If the value is > C<UV_MAX>, C<grok_hex>
+returns
C<UV_MAX>, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
+and writes the value to C<*result> (or the value is discarded if C<result>
+is C<NULL>).
-The hex number may optionally be prefixed with "0x" or "x" unless
-C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry. If
-C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the hex
-number may use '_' characters to separate digits.
+The hex number may optionally be prefixed with C<"0x"> or C<"x"> unless
+C<PERL_SCAN_DISALLOW_PREFIX> is set in C<*flags> on entry. If
+C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then the hex
+number may use C<"_"> characters to separate digits.
=cut
converts a string representing an octal number to numeric form.
-On entry I<start> and I<*len> give the string to scan, I<*flags> gives
-conversion flags, and I<result> should be NULL or a pointer to an NV.
+On entry C<start> and C<*len> give the string to scan, C<*flags> gives
+conversion flags, and C<result> should be C<NULL> or a pointer to an NV.
The scan stops at the end of the string, or the first invalid character.
-Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in I<*flags>, encountering an
+Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in C<*flags>, encountering an
8 or 9 will also trigger a warning.
-On return I<*len> is set to the length of the scanned string,
-and I<*flags> gives output flags.
+On return C<*len> is set to the length of the scanned string,
+and C<*flags> gives output flags.
-If the value is <= UV_MAX it is returned as a UV, the output flags are clear,
-and nothing is written to I<*result>. If the value is > UV_MAX C<grok_oct>
-returns
UV_MAX, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
-and writes the value to I<*result> (or the value is discarded if I<result>
-is NULL).
+If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
+and nothing is written to C<*result>. If the value is > C<UV_MAX>, C<grok_oct>
+returns
C<UV_MAX>, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
+and writes the value to C<*result> (or the value is discarded if C<result>
+is C<NULL>).
-If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the octal
-number may use '_' characters to separate digits.
+If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then the octal
+number may use C<"_"> characters to separate digits.
=cut
PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
if (IN_LC(LC_NUMERIC)) {
- DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
if (PL_numeric_radix_sv) {
STRLEN len;
const char * const radix = SvPV(PL_numeric_radix_sv, len);
}
/*
-=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;
- STRLEN j = (NV_MANT_REAL_DIG - 1) % 8;
-
- PERL_ARGS_ASSERT_NAN_HIBYTE;
-
- *mask = 1 << j;
-#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(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. */
- 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 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 = Perl_nan_hibyte(&nv, &mask);
- /* 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);
- } else {
- return 0;
- }
-#endif
-}
-
-/* The largest known floating point numbers are the IEEE quadruple
- * precision of 128 bits. */
-#define MAX_NV_BYTES (128/8)
-
-static const char nan_payload_error[] = "NaN payload error";
-
-/*
-
-=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(NV *nvp, 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_MANT_REAL_DIG - 1;
-
- STRLEN i, nvi;
- bool error = FALSE;
-
- /* XXX None of this works for doubledouble platforms, or for mixendians. */
-
- PERL_ARGS_ASSERT_NAN_PAYLOAD_SET;
-
- *nvp = NV_NAN;
-
-#ifdef NV_BIG_ENDIAN
- nvi = NVSIZE - 1;
-#endif
-#ifdef NV_LITTLE_ENDIAN
- nvi = 0;
-#endif
-
- if (byten > MAX_NV_BYTES) {
- byten = MAX_NV_BYTES;
- error = 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 (error) {
- Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
- nan_payload_error);
- }
- nan_signaling_set(nvp, signaling);
-}
-
-/*
=for apidoc grok_infnan
-Helper for grok_number(), accepts various ways of spelling "infinity"
+Helper for C<grok_number()>, accepts various ways of spelling "infinity"
or "not a number", and returns one of the following flag combinations:
IS_NUMBER_INFINITE
IS_NUMBER_NAN | IS_NUMBER_NEG
0
-possibly |-ed with IS_NUMBER_TRAILING.
+possibly |-ed with C<IS_NUMBER_TRAILING>.
-If an infinity or a not-a-number is recognized, the *sp will point to
+If an infinity or a not-a-number is recognized, C<*sp> will point to
one byte past the end of the recognized string. If the recognition fails,
-zero is returned, and the *sp will not move.
+zero is returned, and C<*sp> will not move.
=cut
*/
{
const char* s = *sp;
int flags = 0;
+#if defined(NV_INF) || defined(NV_NAN)
bool odh = FALSE; /* one-dot-hash: 1.#INF */
PERL_ARGS_ASSERT_GROK_INFNAN;
while (s < send && isSPACE(*s))
s++;
+#else
+ PERL_UNUSED_ARG(send);
+#endif /* #if defined(NV_INF) || defined(NV_NAN) */
*sp = s;
return flags;
}
Recognise (or not) a number. The type of the number is returned
(0 if unrecognised), otherwise it is a bit-ORed combination of
-IS_NUMBER_IN_UV, IS_NUMBER_GREATER_THAN_UV_MAX, IS_NUMBER_NOT_INT,
-IS_NUMBER_NEG, IS_NUMBER_INFINITY, IS_NUMBER_NAN (defined in perl.h).
-
-If the value of the number can fit in a UV, it is returned in the *valuep
-IS_NUMBER_IN_UV will be set to indicate that *valuep is valid, IS_NUMBER_IN_UV
-will never be set unless *valuep is valid, but *valuep may have been assigned
-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.
-
-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
-absolute value). IS_NUMBER_IN_UV is not set if e notation was used or the
+C<IS_NUMBER_IN_UV>, C<IS_NUMBER_GREATER_THAN_UV_MAX>, C<IS_NUMBER_NOT_INT>,
+C<IS_NUMBER_NEG>, C<IS_NUMBER_INFINITY>, C<IS_NUMBER_NAN> (defined in perl.h).
+
+If the value of the number can fit in a UV, it is returned in C<*valuep>.
+C<IS_NUMBER_IN_UV> will be set to indicate that C<*valuep> is valid, C<IS_NUMBER_IN_UV>
+will never be set unless C<*valuep> is valid, but C<*valuep> may have been assigned
+to during processing even though C<IS_NUMBER_IN_UV> is not set on return.
+If C<valuep> is C<NULL>, C<IS_NUMBER_IN_UV> will be set for the same cases as when
+C<valuep> is non-C<NULL>, but no actual assignment (or SEGV) will occur.
+
+C<IS_NUMBER_NOT_INT> will be set with C<IS_NUMBER_IN_UV> if trailing decimals were
+seen (in which case C<*valuep> gives the true value truncated to an integer), and
+C<IS_NUMBER_NEG> if the number is negative (in which case C<*valuep> holds the
+absolute value). C<IS_NUMBER_IN_UV> is not set if e notation was used or the
number is larger than a UV.
C<flags> allows only C<PERL_SCAN_TRAILING>, which allows for trailing
=for apidoc grok_number
-Identical to grok_number_flags() with flags set to zero.
+Identical to C<grok_number_flags()> with C<flags> set to zero.
=cut
*/
s++;
if (s >= send)
return numtype;
- if (len == 10 && memEQ(pv, "0 but true", 10)) {
+ if (memEQs(pv, len, "0 but true")) {
if (valuep)
*valuep = 0;
return IS_NUMBER_IN_UV;
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". */
- int infnan = Perl_grok_infnan(aTHX_ &d, send);
+ const int infnan = Perl_grok_infnan(aTHX_ &d, send);
if ((infnan & IS_NUMBER_INFINITY)) {
return (numtype | infnan); /* Keep sign for infinity. */
}
}
/*
-=for apidoc grok_atou
-
-grok_atou is a safer replacement for atoi and strtol.
+grok_atoUV
-grok_atou parses a C-style zero-byte terminated string, looking for
+grok_atoUV parses a C-style zero-byte terminated string, looking for
a decimal unsigned integer.
Returns the unsigned integer, if a valid value can be parsed
Accepts only the decimal digits '0'..'9'.
-As opposed to atoi or strtol, grok_atou does NOT allow optional
+As opposed to atoi or strtol, grok_atoUV does NOT allow optional
leading whitespace, or negative inputs. If such features are
required, the calling code needs to explicitly implement those.
-If a valid value cannot be parsed, returns either zero (if non-digits
-are met before any digits) or UV_MAX (if the value overflows).
-
-Note that extraneous leading zeros also count as an overflow
-(meaning that only "0" is the zero).
-
-On failure, the *endptr is also set to NULL, unless endptr is NULL.
-
-Trailing non-digit bytes are allowed if the endptr is non-NULL.
-On return the *endptr will contain the pointer to the first non-digit byte.
+Returns true if a valid value could be parsed. In that case, valptr
+is set to the parsed value, and endptr (if provided) is set to point
+to the character after the last digit.
-If the endptr is NULL, the first non-digit byte MUST be
-the zero byte terminating the pv, or zero will be returned.
+Returns false otherwise. This can happen if a) there is a leading zero
+followed by another digit; b) the digits would overflow a UV; or c)
+there are trailing non-digits AND endptr is not provided.
Background: atoi has severe problems with illegal inputs, it cannot be
used for incremental parsing, and therefore should be avoided
atoi and strtol are also affected by locale settings, which can also be
seen as a bug (global state controlled by user environment).
-=cut
*/
-UV
-Perl_grok_atou(const char *pv, const char** endptr)
+bool
+Perl_grok_atoUV(const char *pv, UV *valptr, const char** endptr)
{
const char* s = pv;
const char** eptr;
const char* end2; /* Used in case endptr is NULL. */
- UV val = 0; /* The return value. */
+ UV val = 0; /* The parsed value. */
- PERL_ARGS_ASSERT_GROK_ATOU;
+ PERL_ARGS_ASSERT_GROK_ATOUV;
eptr = endptr ? endptr : &end2;
if (isDIGIT(*s)) {
/* Single-digit inputs are quite common. */
val = *s++ - '0';
if (isDIGIT(*s)) {
- /* Extra leading zeros cause overflow. */
- if (val == 0) {
- *eptr = NULL;
- return UV_MAX;
- }
+ /* Fail on extra leading zeros. */
+ if (val == 0)
+ return FALSE;
while (isDIGIT(*s)) {
/* This could be unrolled like in grok_number(), but
* the expected uses of this are not speed-needy, and
* unlikely to need full 64-bitness. */
- U8 digit = *s++ - '0';
+ const U8 digit = *s++ - '0';
if (val < uv_max_div_10 ||
(val == uv_max_div_10 && digit <= uv_max_mod_10)) {
val = val * 10 + digit;
} else {
- *eptr = NULL;
- return UV_MAX;
+ return FALSE;
}
}
}
}
- if (s == pv) {
- *eptr = NULL; /* If no progress, failed to parse anything. */
- return 0;
- }
- if (endptr == NULL && *s) {
- return 0; /* If endptr is NULL, no trailing non-digits allowed. */
- }
+ if (s == pv)
+ return FALSE;
+ if (endptr == NULL && *s)
+ return FALSE; /* If endptr is NULL, no trailing non-digits allowed. */
*eptr = s;
- return val;
+ *valptr = val;
+ return TRUE;
}
#ifndef USE_QUADMATH
* a hammer. Therefore we need to catch potential overflows before
* it's too late. */
-#if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS)) && defined(NV_MAX_10_EXP)
+#if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS) || defined(DOUBLE_IS_VAX_FLOAT)) && defined(NV_MAX_10_EXP)
STMT_START {
const NV exp_v = log10(value);
if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP)
result *= power;
#ifdef FP_OVERFLOWS_TO_ZERO
if (result == 0)
+# ifdef NV_INF
return value < 0 ? -NV_INF : NV_INF;
+# else
+ return value < 0 ? -FLT_MAX : FLT_MAX;
+# endif
#endif
/* Floating point exceptions are supposed to be turned off,
* but if we're obviously done, don't risk another iteration.
NV
Perl_my_atof(pTHX_ const char* s)
{
+ /* 's' must be NUL terminated */
+
NV x = 0.0;
+
+ PERL_ARGS_ASSERT_MY_ATOF;
+
#ifdef USE_QUADMATH
+
Perl_my_atof2(aTHX_ s, &x);
- return x;
+
+#elif ! defined(USE_LOCALE_NUMERIC)
+
+ Perl_atof2(s, x);
+
#else
-# ifdef USE_LOCALE_NUMERIC
- PERL_ARGS_ASSERT_MY_ATOF;
{
- DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
- const char *standard = NULL, *local = NULL;
- bool use_standard_radix;
-
/* Look through the string for the first thing that looks like a
* decimal point: either the value in the current locale or the
* standard fallback of '.'. The one which appears earliest in the
* that we have to determine this beforehand because on some
* systems, Perl_atof2 is just a wrapper around the system's atof.
* */
- standard = strchr(s, '.');
- local = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
-
- use_standard_radix = standard && (!local || standard < local);
+ const char * const standard_pos = strchr(s, '.');
+ const char * const local_pos
+ = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
+ const bool use_standard_radix
+ = standard_pos && (!local_pos || standard_pos < local_pos);
if (use_standard_radix)
SET_NUMERIC_STANDARD();
Perl_atof2(s, x);
if (use_standard_radix)
- SET_NUMERIC_LOCAL();
+ SET_NUMERIC_UNDERLYING();
}
else
Perl_atof2(s, x);
RESTORE_LC_NUMERIC();
}
-# else
- Perl_atof2(s, x);
-# endif
+
#endif
+
return x;
}
+#if defined(NV_INF) || defined(NV_NAN)
#ifdef USING_MSVC6
# pragma warning(push)
{
const char *p0 = negative ? s - 1 : s;
const char *p = p0;
- int infnan = grok_infnan(&p, send);
+ const 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 still here, we didn't have either NV_INF or NV_NAN,
* and can try falling back to native strtod/strtold.
*
- * (Though, are our NV_INF or NV_NAN ever not defined?)
- *
* The native interface might not recognize all the possible
* inf/nan strings Perl recognizes. What we can try
* is to try faking the input. We will try inf/-inf/nan
const char* fake = NULL;
char* endp;
NV nv;
+#ifdef NV_INF
if ((infnan & IS_NUMBER_INFINITY)) {
fake = ((infnan & IS_NUMBER_NEG)) ? "-inf" : "inf";
}
- else if ((infnan & IS_NUMBER_NAN)) {
+#endif
+#ifdef NV_NAN
+ if ((infnan & IS_NUMBER_NAN)) {
fake = "nan";
}
+#endif
assert(fake);
nv = Perl_strtod(fake, &endp);
if (fake != endp) {
+#ifdef NV_INF
if ((infnan & IS_NUMBER_INFINITY)) {
-#ifdef Perl_isinf
+# ifdef Perl_isinf
if (Perl_isinf(nv))
*value = nv;
-#else
+# else
/* last resort, may generate SIGFPE */
*value = Perl_exp((NV)1e9);
if ((infnan & IS_NUMBER_NEG))
*value = -*value;
-#endif
+# endif
return (char*)p; /* p, not endp */
}
- else if ((infnan & IS_NUMBER_NAN)) {
-#ifdef Perl_isnan
+#endif
+#ifdef NV_NAN
+ if ((infnan & IS_NUMBER_NAN)) {
+# ifdef Perl_isnan
if (Perl_isnan(nv))
*value = nv;
-#else
+# else
/* last resort, may generate SIGFPE */
*value = Perl_log((NV)-1.0);
-#endif
+# endif
return (char*)p; /* p, not endp */
+#endif
}
}
}
# pragma warning(pop)
#endif
+#endif /* if defined(NV_INF) || defined(NV_NAN) */
+
char*
Perl_my_atof2(pTHX_ const char* orig, NV* value)
{
#ifdef USE_QUADMATH
{
char* endp;
- if ((endp = S_my_atof_infnan(s, negative, send, value)))
+ if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
return endp;
result[2] = strtoflt128(s, &endp);
if (s != endp) {
/* the max number we can accumulate in a UV, and still safely do 10*N+9 */
#define MAX_ACCUMULATE ( (UV) ((UV_MAX - 9)/10))
+#if defined(NV_INF) || defined(NV_NAN)
{
- const char* endp;
+ char* endp;
if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
- return (char*)endp;
+ return endp;
}
+#endif
/* we accumulate digits into an integer; when this becomes too
* large, we add the total to NV and start again */
else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) {
seen_dp = 1;
if (sig_digits > MAX_SIG_DIGITS) {
- do {
+ while (isDIGIT(*s)) {
++s;
- } while (isDIGIT(*s));
+ }
break;
}
}
/*
=for apidoc isinfnan
-Perl_isinfnan() is utility function that returns true if the NV
-argument is either an infinity or a NaN, false otherwise. To test
-in more detail, use Perl_isinf() and Perl_isnan().
+C<Perl_isinfnan()> is utility function that returns true if the NV
+argument is either an infinity or a C<NaN>, false otherwise. To test
+in more detail, use C<Perl_isinf()> and C<Perl_isnan()>.
This is also the logical inverse of Perl_isfinite().
bool
Perl_isinfnan(NV nv)
{
+ PERL_UNUSED_ARG(nv);
#ifdef Perl_isinf
if (Perl_isinf(nv))
return TRUE;
/*
=for apidoc
-Checks whether the argument would be either an infinity or NaN when used
+Checks whether the argument would be either an infinity or C<NaN> when used
as a number, but is careful not to trigger non-numeric or uninitialized
-warnings. it assumes the caller has done SvGETMAGIC(sv) already.
+warnings. it assumes the caller has done C<SvGETMAGIC(sv)> already.
=cut
*/
Return a non-zero integer if the sign bit on an NV is set, and 0 if
it is not.
-If Configure detects this system has a signbit() that will work with
-our NVs, then we just use it via the #define in perl.h. Otherwise,
+If F<Configure> detects this system has a C<signbit()> that will work with
+our NVs, then we just use it via the C<#define> in F<perl.h>. Otherwise,
fall back on this implementation. The main use of this function
-is catching -0.0.
+is catching C<-0.0>.
-Configure notes: This function is called 'Perl_signbit' instead of a
-plain 'signbit' because it is easy to imagine a system having a signbit()
+C<Configure> notes: This function is called C<'Perl_signbit'> instead of a
+plain C<'signbit'> because it is easy to imagine a system having a C<signbit()>
function or macro that doesn't happen to work with our particular choice
-of NVs. We shouldn't just re-#define signbit as Perl_signbit and expect
+of NVs. We shouldn't just re-C<#define> C<signbit> as C<Perl_signbit> and expect
the standard system headers to be happy. Also, this is a no-context
-function (no pTHX_) because Perl_signbit() is usually re-#defined in
-perl.h as a simple macro call to the system's signbit().
-Users should just always call Perl_signbit().
+function (no C<pTHX_>) because C<Perl_signbit()> is usually re-C<#defined> in
+F<perl.h> as a simple macro call to the system's C<signbit()>.
+Users should just always call C<Perl_signbit()>.
=cut
*/
int
Perl_signbit(NV x) {
# ifdef Perl_fp_class_nzero
- if (x == 0)
- return Perl_fp_class_nzero(x);
-# endif
+ return Perl_fp_class_nzero(x);
+ /* Try finding the high byte, and assume it's highest bit
+ * is the sign. This assumption is probably wrong somewhere. */
+# elif defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
+ return (((unsigned char *)&x)[9] & 0x80);
+# elif defined(NV_LITTLE_ENDIAN)
+ /* Note that NVSIZE is sizeof(NV), which would make the below be
+ * wrong if the end bytes are unused, which happens with the x86
+ * 80-bit long doubles, which is why take care of that above. */
+ return (((unsigned char *)&x)[NVSIZE - 1] & 0x80);
+# elif defined(NV_BIG_ENDIAN)
+ return (((unsigned char *)&x)[0] & 0x80);
+# else
+ /* This last resort fallback is wrong for the negative zero. */
return (x < 0.0) ? 1 : 0;
+# endif
}
#endif
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff