3 * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
4 * 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
12 * "That only makes eleven (plus one mislaid) and not fourteen,
13 * unless wizards count differently to other people." --Beorn
15 * [p.115 of _The Hobbit_: "Queer Lodgings"]
19 =head1 Numeric functions
23 This file contains all the stuff needed by perl for manipulating numeric
24 values, including such things as replacements for the OS's atof() function
29 #define PERL_IN_NUMERIC_C
35 S_strtod(pTHX_ const char * const s, char ** e)
37 DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
40 STORE_LC_NUMERIC_SET_TO_NEEDED();
44 result = strtoflt128(s, e);
46 # elif defined(HAS_STRTOLD) && defined(HAS_LONG_DOUBLE) \
47 && defined(USE_LONG_DOUBLE)
48 # if defined(__MINGW64_VERSION_MAJOR)
49 /***********************************************
50 We are unable to use strtold because of
51 https://sourceforge.net/p/mingw-w64/bugs/711/
53 https://sourceforge.net/p/mingw-w64/bugs/725/
55 but __mingw_strtold is fine.
56 ***********************************************/
58 result = __mingw_strtold(s, e);
62 result = strtold(s, e);
65 # elif defined(HAS_STRTOD)
67 result = strtod(s, e);
70 # error No strtod() equivalent found
78 #endif /* #ifdef Perl_strtod */
84 This function is equivalent to the libc strtod() function, and is available
85 even on platforms that lack plain strtod(). Its return value is the best
86 available precision depending on platform capabilities and F<Configure>
89 It properly handles the locale radix character, meaning it expects a dot except
90 when called from within the scope of S<C<use locale>>, in which case the radix
91 character should be that specified by the current locale.
93 The synonym Strod() may be used instead.
100 Perl_my_strtod(const char * const s, char **e)
104 PERL_ARGS_ASSERT_MY_STRTOD;
108 return S_strtod(aTHX_ s, e);
114 char ** end_ptr = NULL;
116 *end_ptr = my_atof2(s, &result);
134 Perl_cast_ulong(NV f)
137 return f < I32_MIN ? (U32) I32_MIN : (U32)(I32) f;
138 if (f < U32_MAX_P1) {
140 if (f < U32_MAX_P1_HALF)
142 f -= U32_MAX_P1_HALF;
143 return ((U32) f) | (1 + (U32_MAX >> 1));
148 return f > 0 ? U32_MAX : 0 /* NaN */;
155 return f < I32_MIN ? I32_MIN : (I32) f;
156 if (f < U32_MAX_P1) {
158 if (f < U32_MAX_P1_HALF)
160 f -= U32_MAX_P1_HALF;
161 return (I32)(((U32) f) | (1 + (U32_MAX >> 1)));
166 return f > 0 ? (I32)U32_MAX : 0 /* NaN */;
173 return f < IV_MIN ? IV_MIN : (IV) f;
176 /* For future flexibility allowing for sizeof(UV) >= sizeof(IV) */
177 if (f < UV_MAX_P1_HALF)
180 return (IV)(((UV) f) | (1 + (UV_MAX >> 1)));
185 return f > 0 ? (IV)UV_MAX : 0 /* NaN */;
192 return f < IV_MIN ? (UV) IV_MIN : (UV)(IV) f;
195 if (f < UV_MAX_P1_HALF)
198 return ((UV) f) | (1 + (UV_MAX >> 1));
203 return f > 0 ? UV_MAX : 0 /* NaN */;
209 converts a string representing a binary number to numeric form.
211 On entry C<start> and C<*len> give the string to scan, C<*flags> gives
212 conversion flags, and C<result> should be C<NULL> or a pointer to an NV.
213 The scan stops at the end of the string, or the first invalid character.
214 Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in C<*flags>, encountering an
215 invalid character will also trigger a warning.
216 On return C<*len> is set to the length of the scanned string,
217 and C<*flags> gives output flags.
219 If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
220 and nothing is written to C<*result>. If the value is > C<UV_MAX>, C<grok_bin>
221 returns C<UV_MAX>, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
222 and writes the value to C<*result> (or the value is discarded if C<result>
225 The binary number may optionally be prefixed with C<"0b"> or C<"b"> unless
226 C<PERL_SCAN_DISALLOW_PREFIX> is set in C<*flags> on entry. If
227 C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then the binary
228 number may use C<"_"> characters to separate digits.
232 Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE
233 which suppresses any message for non-portable numbers that are still valid
238 Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
240 const char *s = start;
245 const UV max_div_2 = UV_MAX / 2;
246 const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
247 bool overflowed = FALSE;
250 PERL_ARGS_ASSERT_GROK_BIN;
252 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
253 /* strip off leading b or 0b.
254 for compatibility silently suffer "b" and "0b" as valid binary
257 if (isALPHA_FOLD_EQ(s[0], 'b')) {
261 else if (len >= 2 && s[0] == '0' && (isALPHA_FOLD_EQ(s[1], 'b'))) {
268 for (; len-- && (bit = *s); s++) {
269 if (bit == '0' || bit == '1') {
270 /* Write it in this wonky order with a goto to attempt to get the
271 compiler to make the common case integer-only loop pretty tight.
272 With gcc seems to be much straighter code than old scan_bin. */
275 if (value <= max_div_2) {
276 value = (value << 1) | (bit - '0');
279 /* Bah. We're just overflowed. */
280 /* diag_listed_as: Integer overflow in %s number */
281 Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
282 "Integer overflow in binary number");
284 value_nv = (NV) value;
287 /* If an NV has not enough bits in its mantissa to
288 * represent a UV this summing of small low-order numbers
289 * is a waste of time (because the NV cannot preserve
290 * the low-order bits anyway): we could just remember when
291 * did we overflow and in the end just multiply value_nv by the
293 value_nv += (NV)(bit - '0');
296 if (bit == '_' && len && allow_underscores && (bit = s[1])
297 && (bit == '0' || bit == '1'))
303 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
304 Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
305 "Illegal binary digit '%c' ignored", *s);
309 if ( ( overflowed && value_nv > 4294967295.0)
311 || (!overflowed && value > 0xffffffff
312 && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE))
315 Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
316 "Binary number > 0b11111111111111111111111111111111 non-portable");
323 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
332 converts a string representing a hex number to numeric form.
334 On entry C<start> and C<*len_p> give the string to scan, C<*flags> gives
335 conversion flags, and C<result> should be C<NULL> or a pointer to an NV.
336 The scan stops at the end of the string, or the first invalid character.
337 Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in C<*flags>, encountering an
338 invalid character will also trigger a warning.
339 On return C<*len> is set to the length of the scanned string,
340 and C<*flags> gives output flags.
342 If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
343 and nothing is written to C<*result>. If the value is > C<UV_MAX>, C<grok_hex>
344 returns C<UV_MAX>, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
345 and writes the value to C<*result> (or the value is discarded if C<result>
348 The hex number may optionally be prefixed with C<"0x"> or C<"x"> unless
349 C<PERL_SCAN_DISALLOW_PREFIX> is set in C<*flags> on entry. If
350 C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then the hex
351 number may use C<"_"> characters to separate digits.
355 Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE
356 which suppresses any message for non-portable numbers, but which are valid
361 Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
363 const char *s = start;
367 const UV max_div_16 = UV_MAX / 16;
368 const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
369 bool overflowed = FALSE;
371 PERL_ARGS_ASSERT_GROK_HEX;
373 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
374 /* strip off leading x or 0x.
375 for compatibility silently suffer "x" and "0x" as valid hex numbers.
378 if (isALPHA_FOLD_EQ(s[0], 'x')) {
382 else if (len >= 2 && s[0] == '0' && (isALPHA_FOLD_EQ(s[1], 'x'))) {
389 for (; len-- && *s; s++) {
391 /* Write it in this wonky order with a goto to attempt to get the
392 compiler to make the common case integer-only loop pretty tight.
393 With gcc seems to be much straighter code than old scan_hex. */
396 if (value <= max_div_16) {
397 value = (value << 4) | XDIGIT_VALUE(*s);
400 /* Bah. We're just overflowed. */
401 /* diag_listed_as: Integer overflow in %s number */
402 Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
403 "Integer overflow in hexadecimal number");
405 value_nv = (NV) value;
408 /* If an NV has not enough bits in its mantissa to
409 * represent a UV this summing of small low-order numbers
410 * is a waste of time (because the NV cannot preserve
411 * the low-order bits anyway): we could just remember when
412 * did we overflow and in the end just multiply value_nv by the
413 * right amount of 16-tuples. */
414 value_nv += (NV) XDIGIT_VALUE(*s);
417 if (*s == '_' && len && allow_underscores && s[1]
424 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
425 Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
426 "Illegal hexadecimal digit '%c' ignored", *s);
430 if ( ( overflowed && value_nv > 4294967295.0)
432 || (!overflowed && value > 0xffffffff
433 && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE))
436 Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
437 "Hexadecimal number > 0xffffffff non-portable");
444 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
453 converts a string representing an octal number to numeric form.
455 On entry C<start> and C<*len> give the string to scan, C<*flags> gives
456 conversion flags, and C<result> should be C<NULL> or a pointer to an NV.
457 The scan stops at the end of the string, or the first invalid character.
458 Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in C<*flags>, encountering an
459 8 or 9 will also trigger a warning.
460 On return C<*len> is set to the length of the scanned string,
461 and C<*flags> gives output flags.
463 If the value is <= C<UV_MAX> it is returned as a UV, the output flags are clear,
464 and nothing is written to C<*result>. If the value is > C<UV_MAX>, C<grok_oct>
465 returns C<UV_MAX>, sets C<PERL_SCAN_GREATER_THAN_UV_MAX> in the output flags,
466 and writes the value to C<*result> (or the value is discarded if C<result>
469 If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then the octal
470 number may use C<"_"> characters to separate digits.
474 Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE>
475 which suppresses any message for non-portable numbers, but which are valid
480 Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
482 const char *s = start;
486 const UV max_div_8 = UV_MAX / 8;
487 const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
488 bool overflowed = FALSE;
490 PERL_ARGS_ASSERT_GROK_OCT;
492 for (; len-- && *s; s++) {
494 /* Write it in this wonky order with a goto to attempt to get the
495 compiler to make the common case integer-only loop pretty tight.
499 if (value <= max_div_8) {
500 value = (value << 3) | OCTAL_VALUE(*s);
503 /* Bah. We're just overflowed. */
504 /* diag_listed_as: Integer overflow in %s number */
505 Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
506 "Integer overflow in octal number");
508 value_nv = (NV) value;
511 /* If an NV has not enough bits in its mantissa to
512 * represent a UV this summing of small low-order numbers
513 * is a waste of time (because the NV cannot preserve
514 * the low-order bits anyway): we could just remember when
515 * did we overflow and in the end just multiply value_nv by the
516 * right amount of 8-tuples. */
517 value_nv += (NV) OCTAL_VALUE(*s);
520 if (*s == '_' && len && allow_underscores && isOCTAL(s[1])) {
525 /* Allow \octal to work the DWIM way (that is, stop scanning
526 * as soon as non-octal characters are seen, complain only if
527 * someone seems to want to use the digits eight and nine. Since we
528 * know it is not octal, then if isDIGIT, must be an 8 or 9). */
530 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
531 Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
532 "Illegal octal digit '%c' ignored", *s);
537 if ( ( overflowed && value_nv > 4294967295.0)
539 || (!overflowed && value > 0xffffffff
540 && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE))
543 Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
544 "Octal number > 037777777777 non-portable");
551 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
560 For backwards compatibility. Use C<grok_bin> instead.
564 For backwards compatibility. Use C<grok_hex> instead.
568 For backwards compatibility. Use C<grok_oct> instead.
574 Perl_scan_bin(pTHX_ const char *start, STRLEN len, STRLEN *retlen)
577 I32 flags = *retlen ? PERL_SCAN_ALLOW_UNDERSCORES : 0;
578 const UV ruv = grok_bin (start, &len, &flags, &rnv);
580 PERL_ARGS_ASSERT_SCAN_BIN;
583 return (flags & PERL_SCAN_GREATER_THAN_UV_MAX) ? rnv : (NV)ruv;
587 Perl_scan_oct(pTHX_ const char *start, STRLEN len, STRLEN *retlen)
590 I32 flags = *retlen ? PERL_SCAN_ALLOW_UNDERSCORES : 0;
591 const UV ruv = grok_oct (start, &len, &flags, &rnv);
593 PERL_ARGS_ASSERT_SCAN_OCT;
596 return (flags & PERL_SCAN_GREATER_THAN_UV_MAX) ? rnv : (NV)ruv;
600 Perl_scan_hex(pTHX_ const char *start, STRLEN len, STRLEN *retlen)
603 I32 flags = *retlen ? PERL_SCAN_ALLOW_UNDERSCORES : 0;
604 const UV ruv = grok_hex (start, &len, &flags, &rnv);
606 PERL_ARGS_ASSERT_SCAN_HEX;
609 return (flags & PERL_SCAN_GREATER_THAN_UV_MAX) ? rnv : (NV)ruv;
613 =for apidoc grok_numeric_radix
615 Scan and skip for a numeric decimal separator (radix).
620 Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
622 PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
624 #ifdef USE_LOCALE_NUMERIC
626 if (IN_LC(LC_NUMERIC)) {
629 bool matches_radix = FALSE;
630 DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
632 STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
634 radix = SvPV(PL_numeric_radix_sv, len);
635 radix = savepvn(radix, len);
637 RESTORE_LC_NUMERIC();
639 if (*sp + len <= send) {
640 matches_radix = memEQ(*sp, radix, len);
653 /* always try "." if numeric radix didn't match because
654 * we may have data from different locales mixed */
655 if (*sp < send && **sp == '.') {
664 =for apidoc grok_infnan
666 Helper for C<grok_number()>, accepts various ways of spelling "infinity"
667 or "not a number", and returns one of the following flag combinations:
671 IS_NUMBER_INFINITY | IS_NUMBER_NEG
672 IS_NUMBER_NAN | IS_NUMBER_NEG
675 possibly |-ed with C<IS_NUMBER_TRAILING>.
677 If an infinity or a not-a-number is recognized, C<*sp> will point to
678 one byte past the end of the recognized string. If the recognition fails,
679 zero is returned, and C<*sp> will not move.
685 Perl_grok_infnan(pTHX_ const char** sp, const char* send)
689 #if defined(NV_INF) || defined(NV_NAN)
690 bool odh = FALSE; /* one-dot-hash: 1.#INF */
692 PERL_ARGS_ASSERT_GROK_INFNAN;
695 s++; if (s == send) return 0;
697 else if (*s == '-') {
698 flags |= IS_NUMBER_NEG; /* Yes, -NaN happens. Incorrect but happens. */
699 s++; if (s == send) return 0;
703 /* Visual C: 1.#SNAN, -1.#QNAN, 1#INF, 1.#IND (maybe also 1.#NAN)
704 * Let's keep the dot optional. */
705 s++; if (s == send) return 0;
707 s++; if (s == send) return 0;
710 s++; if (s == send) return 0;
716 if (isALPHA_FOLD_EQ(*s, 'I')) {
717 /* INF or IND (1.#IND is "indeterminate", a certain type of NAN) */
719 s++; if (s == send || isALPHA_FOLD_NE(*s, 'N')) return 0;
720 s++; if (s == send) return 0;
721 if (isALPHA_FOLD_EQ(*s, 'F')) {
723 if (s < send && (isALPHA_FOLD_EQ(*s, 'I'))) {
725 flags | IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT | IS_NUMBER_TRAILING;
726 s++; if (s == send || isALPHA_FOLD_NE(*s, 'N')) return fail;
727 s++; if (s == send || isALPHA_FOLD_NE(*s, 'I')) return fail;
728 s++; if (s == send || isALPHA_FOLD_NE(*s, 'T')) return fail;
729 s++; if (s == send || isALPHA_FOLD_NE(*s, 'Y')) return fail;
732 while (*s == '0') { /* 1.#INF00 */
736 while (s < send && isSPACE(*s))
738 if (s < send && *s) {
739 flags |= IS_NUMBER_TRAILING;
741 flags |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
743 else if (isALPHA_FOLD_EQ(*s, 'D') && odh) { /* 1.#IND */
745 flags |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
746 while (*s == '0') { /* 1.#IND00 */
750 flags |= IS_NUMBER_TRAILING;
756 /* Maybe NAN of some sort */
758 if (isALPHA_FOLD_EQ(*s, 'S') || isALPHA_FOLD_EQ(*s, 'Q')) {
760 /* XXX do something with the snan/qnan difference */
761 s++; if (s == send) return 0;
764 if (isALPHA_FOLD_EQ(*s, 'N')) {
765 s++; if (s == send || isALPHA_FOLD_NE(*s, 'A')) return 0;
766 s++; if (s == send || isALPHA_FOLD_NE(*s, 'N')) return 0;
769 flags |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
771 /* NaN can be followed by various stuff (NaNQ, NaNS), but
772 * there are also multiple different NaN values, and some
773 * implementations output the "payload" values,
774 * e.g. NaN123, NAN(abc), while some legacy implementations
775 * have weird stuff like NaN%. */
776 if (isALPHA_FOLD_EQ(*s, 'q') ||
777 isALPHA_FOLD_EQ(*s, 's')) {
778 /* "nanq" or "nans" are ok, though generating
779 * these portably is tricky. */
783 /* C99 style "nan(123)" or Perlish equivalent "nan($uv)". */
787 return flags | IS_NUMBER_TRAILING;
790 while (t < send && *t && *t != ')') {
794 return flags | IS_NUMBER_TRAILING;
799 if (s[0] == '0' && s + 2 < t &&
800 isALPHA_FOLD_EQ(s[1], 'x') &&
803 I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
804 nanval = grok_hex(s, &len, &flags, NULL);
805 if ((flags & PERL_SCAN_GREATER_THAN_UV_MAX)) {
808 nantype = IS_NUMBER_IN_UV;
811 } else if (s[0] == '0' && s + 2 < t &&
812 isALPHA_FOLD_EQ(s[1], 'b') &&
813 (s[2] == '0' || s[2] == '1')) {
815 I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
816 nanval = grok_bin(s, &len, &flags, NULL);
817 if ((flags & PERL_SCAN_GREATER_THAN_UV_MAX)) {
820 nantype = IS_NUMBER_IN_UV;
826 grok_number_flags(s, t - s, &nanval,
828 PERL_SCAN_ALLOW_UNDERSCORES);
829 /* Unfortunately grok_number_flags() doesn't
830 * tell how far we got and the ')' will always
831 * be "trailing", so we need to double-check
832 * whether we had something dubious. */
833 for (u = s; u < t; u++) {
835 flags |= IS_NUMBER_TRAILING;
842 /* XXX Doesn't do octal: nan("0123").
843 * Probably not a big loss. */
845 if ((nantype & IS_NUMBER_NOT_INT) ||
846 !(nantype && IS_NUMBER_IN_UV)) {
847 /* XXX the nanval is currently unused, that is,
848 * not inserted as the NaN payload of the NV.
849 * But the above code already parses the C99
850 * nan(...) format. See below, and see also
851 * the nan() in POSIX.xs.
853 * Certain configuration combinations where
854 * NVSIZE is greater than UVSIZE mean that
855 * a single UV cannot contain all the possible
856 * NaN payload bits. There would need to be
857 * some more generic syntax than "nan($uv)".
859 * Issues to keep in mind:
861 * (1) In most common cases there would
862 * not be an integral number of bytes that
863 * could be set, only a certain number of bits.
864 * For example for the common case of
865 * NVSIZE == UVSIZE == 8 there is room for 52
866 * bits in the payload, but the most significant
867 * bit is commonly reserved for the
868 * signaling/quiet bit, leaving 51 bits.
869 * Furthermore, the C99 nan() is supposed
870 * to generate quiet NaNs, so it is doubtful
871 * whether it should be able to generate
872 * signaling NaNs. For the x86 80-bit doubles
873 * (if building a long double Perl) there would
874 * be 62 bits (s/q bit being the 63rd).
876 * (2) Endianness of the payload bits. If the
877 * payload is specified as an UV, the low-order
878 * bits of the UV are naturally little-endianed
879 * (rightmost) bits of the payload. The endianness
880 * of UVs and NVs can be different. */
884 flags |= IS_NUMBER_TRAILING;
887 /* Looked like nan(...), but no close paren. */
888 flags |= IS_NUMBER_TRAILING;
891 while (s < send && isSPACE(*s))
893 if (s < send && *s) {
894 /* Note that we here implicitly accept (parse as
895 * "nan", but with warnings) also any other weird
896 * trailing stuff for "nan". In the above we just
897 * check that if we got the C99-style "nan(...)",
898 * the "..." looks sane.
899 * If in future we accept more ways of specifying
900 * the nan payload, the accepting would happen around
902 flags |= IS_NUMBER_TRAILING;
911 while (s < send && isSPACE(*s))
915 PERL_UNUSED_ARG(send);
916 #endif /* #if defined(NV_INF) || defined(NV_NAN) */
922 =for apidoc grok_number_flags
924 Recognise (or not) a number. The type of the number is returned
925 (0 if unrecognised), otherwise it is a bit-ORed combination of
926 C<IS_NUMBER_IN_UV>, C<IS_NUMBER_GREATER_THAN_UV_MAX>, C<IS_NUMBER_NOT_INT>,
927 C<IS_NUMBER_NEG>, C<IS_NUMBER_INFINITY>, C<IS_NUMBER_NAN> (defined in perl.h).
929 If the value of the number can fit in a UV, it is returned in C<*valuep>.
930 C<IS_NUMBER_IN_UV> will be set to indicate that C<*valuep> is valid, C<IS_NUMBER_IN_UV>
931 will never be set unless C<*valuep> is valid, but C<*valuep> may have been assigned
932 to during processing even though C<IS_NUMBER_IN_UV> is not set on return.
933 If C<valuep> is C<NULL>, C<IS_NUMBER_IN_UV> will be set for the same cases as when
934 C<valuep> is non-C<NULL>, but no actual assignment (or SEGV) will occur.
936 C<IS_NUMBER_NOT_INT> will be set with C<IS_NUMBER_IN_UV> if trailing decimals were
937 seen (in which case C<*valuep> gives the true value truncated to an integer), and
938 C<IS_NUMBER_NEG> if the number is negative (in which case C<*valuep> holds the
939 absolute value). C<IS_NUMBER_IN_UV> is not set if e notation was used or the
940 number is larger than a UV.
942 C<flags> allows only C<PERL_SCAN_TRAILING>, which allows for trailing
943 non-numeric text on an otherwise successful I<grok>, setting
944 C<IS_NUMBER_TRAILING> on the result.
946 =for apidoc grok_number
948 Identical to C<grok_number_flags()> with C<flags> set to zero.
953 Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
955 PERL_ARGS_ASSERT_GROK_NUMBER;
957 return grok_number_flags(pv, len, valuep, 0);
960 static const UV uv_max_div_10 = UV_MAX / 10;
961 static const U8 uv_max_mod_10 = UV_MAX % 10;
964 Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
967 const char * const send = pv + len;
971 PERL_ARGS_ASSERT_GROK_NUMBER_FLAGS;
973 while (s < send && isSPACE(*s))
977 } else if (*s == '-') {
979 numtype = IS_NUMBER_NEG;
987 /* The first digit (after optional sign): note that might
988 * also point to "infinity" or "nan", or "1.#INF". */
991 /* next must be digit or the radix separator or beginning of infinity/nan */
993 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
996 /* This construction seems to be more optimiser friendly.
997 (without it gcc does the isDIGIT test and the *s - '0' separately)
998 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
999 In theory the optimiser could deduce how far to unroll the loop
1000 before checking for overflow. */
1002 int digit = *s - '0';
1003 if (inRANGE(digit, 0, 9)) {
1004 value = value * 10 + digit;
1007 if (inRANGE(digit, 0, 9)) {
1008 value = value * 10 + digit;
1011 if (inRANGE(digit, 0, 9)) {
1012 value = value * 10 + digit;
1015 if (inRANGE(digit, 0, 9)) {
1016 value = value * 10 + digit;
1019 if (inRANGE(digit, 0, 9)) {
1020 value = value * 10 + digit;
1023 if (inRANGE(digit, 0, 9)) {
1024 value = value * 10 + digit;
1027 if (inRANGE(digit, 0, 9)) {
1028 value = value * 10 + digit;
1031 if (inRANGE(digit, 0, 9)) {
1032 value = value * 10 + digit;
1034 /* Now got 9 digits, so need to check
1035 each time for overflow. */
1037 while ( inRANGE(digit, 0, 9)
1038 && (value < uv_max_div_10
1039 || (value == uv_max_div_10
1040 && digit <= uv_max_mod_10))) {
1041 value = value * 10 + digit;
1047 if (inRANGE(digit, 0, 9)
1049 /* value overflowed.
1050 skip the remaining digits, don't
1051 worry about setting *valuep. */
1054 } while (s < send && isDIGIT(*s));
1056 IS_NUMBER_GREATER_THAN_UV_MAX;
1076 numtype |= IS_NUMBER_IN_UV;
1081 if (GROK_NUMERIC_RADIX(&s, send)) {
1082 numtype |= IS_NUMBER_NOT_INT;
1083 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
1087 else if (GROK_NUMERIC_RADIX(&s, send)) {
1088 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
1089 /* no digits before the radix means we need digits after it */
1090 if (s < send && isDIGIT(*s)) {
1093 } while (s < send && isDIGIT(*s));
1095 /* integer approximation is valid - it's 0. */
1103 if (s > d && s < send) {
1104 /* we can have an optional exponent part */
1105 if (isALPHA_FOLD_EQ(*s, 'e')) {
1107 if (s < send && (*s == '-' || *s == '+'))
1109 if (s < send && isDIGIT(*s)) {
1112 } while (s < send && isDIGIT(*s));
1114 else if (flags & PERL_SCAN_TRAILING)
1115 return numtype | IS_NUMBER_TRAILING;
1119 /* The only flag we keep is sign. Blow away any "it's UV" */
1120 numtype &= IS_NUMBER_NEG;
1121 numtype |= IS_NUMBER_NOT_INT;
1124 while (s < send && isSPACE(*s))
1128 if (memEQs(pv, len, "0 but true")) {
1131 return IS_NUMBER_IN_UV;
1133 /* We could be e.g. at "Inf" or "NaN", or at the "#" of "1.#INF". */
1134 if ((s + 2 < send) && strchr("inqs#", toFOLD(*s))) {
1135 /* Really detect inf/nan. Start at d, not s, since the above
1136 * code might have already consumed the "1." or "1". */
1137 const int infnan = Perl_grok_infnan(aTHX_ &d, send);
1138 if ((infnan & IS_NUMBER_INFINITY)) {
1139 return (numtype | infnan); /* Keep sign for infinity. */
1141 else if ((infnan & IS_NUMBER_NAN)) {
1142 return (numtype | infnan) & ~IS_NUMBER_NEG; /* Clear sign for nan. */
1145 else if (flags & PERL_SCAN_TRAILING) {
1146 return numtype | IS_NUMBER_TRAILING;
1153 =for apidoc grok_atoUV
1155 parse a string, looking for a decimal unsigned integer.
1157 On entry, C<pv> points to the beginning of the string;
1158 C<valptr> points to a UV that will receive the converted value, if found;
1159 C<endptr> is either NULL or points to a variable that points to one byte
1160 beyond the point in C<pv> that this routine should examine.
1161 If C<endptr> is NULL, C<pv> is assumed to be NUL-terminated.
1163 Returns FALSE if C<pv> doesn't represent a valid unsigned integer value (with
1164 no leading zeros). Otherwise it returns TRUE, and sets C<*valptr> to that
1167 If you constrain the portion of C<pv> that is looked at by this function (by
1168 passing a non-NULL C<endptr>), and if the intial bytes of that portion form a
1169 valid value, it will return TRUE, setting C<*endptr> to the byte following the
1170 final digit of the value. But if there is no constraint at what's looked at,
1171 all of C<pv> must be valid in order for TRUE to be returned.
1173 The only characters this accepts are the decimal digits '0'..'9'.
1175 As opposed to L<atoi(3)> or L<strtol(3)>, C<grok_atoUV> does NOT allow optional
1176 leading whitespace, nor negative inputs. If such features are required, the
1177 calling code needs to explicitly implement those.
1179 Note that this function returns FALSE for inputs that would overflow a UV,
1180 or have leading zeros. Thus a single C<0> is accepted, but not C<00> nor
1181 C<01>, C<002>, I<etc>.
1183 Background: C<atoi> has severe problems with illegal inputs, it cannot be
1184 used for incremental parsing, and therefore should be avoided
1185 C<atoi> and C<strtol> are also affected by locale settings, which can also be
1186 seen as a bug (global state controlled by user environment).
1193 Perl_grok_atoUV(const char *pv, UV *valptr, const char** endptr)
1197 const char* end2; /* Used in case endptr is NULL. */
1198 UV val = 0; /* The parsed value. */
1200 PERL_ARGS_ASSERT_GROK_ATOUV;
1206 end2 = s + strlen(s);
1216 /* Single-digit inputs are quite common. */
1218 if (s < *eptr && isDIGIT(*s)) {
1219 /* Fail on extra leading zeros. */
1222 while (s < *eptr && isDIGIT(*s)) {
1223 /* This could be unrolled like in grok_number(), but
1224 * the expected uses of this are not speed-needy, and
1225 * unlikely to need full 64-bitness. */
1226 const U8 digit = *s++ - '0';
1227 if (val < uv_max_div_10 ||
1228 (val == uv_max_div_10 && digit <= uv_max_mod_10)) {
1229 val = val * 10 + digit;
1236 if (endptr == NULL) {
1238 return FALSE; /* If endptr is NULL, no trailing non-digits allowed. */
1251 S_mulexp10(NV value, I32 exponent)
1263 /* On OpenVMS VAX we by default use the D_FLOAT double format,
1264 * and that format does not have *easy* capabilities [1] for
1265 * overflowing doubles 'silently' as IEEE fp does. We also need
1266 * to support G_FLOAT on both VAX and Alpha, and though the exponent
1267 * range is much larger than D_FLOAT it still doesn't do silent
1268 * overflow. Therefore we need to detect early whether we would
1269 * overflow (this is the behaviour of the native string-to-float
1270 * conversion routines, and therefore of native applications, too).
1272 * [1] Trying to establish a condition handler to trap floating point
1273 * exceptions is not a good idea. */
1275 /* In UNICOS and in certain Cray models (such as T90) there is no
1276 * IEEE fp, and no way at all from C to catch fp overflows gracefully.
1277 * There is something you can do if you are willing to use some
1278 * inline assembler: the instruction is called DFI-- but that will
1279 * disable *all* floating point interrupts, a little bit too large
1280 * a hammer. Therefore we need to catch potential overflows before
1283 #if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS) || defined(DOUBLE_IS_VAX_FLOAT)) && defined(NV_MAX_10_EXP)
1285 const NV exp_v = log10(value);
1286 if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP)
1289 if (-(exponent + exp_v) >= NV_MAX_10_EXP)
1291 while (-exponent >= NV_MAX_10_EXP) {
1292 /* combination does not overflow, but 10^(-exponent) does */
1302 exponent = -exponent;
1303 #ifdef NV_MAX_10_EXP
1304 /* for something like 1234 x 10^-309, the action of calculating
1305 * the intermediate value 10^309 then returning 1234 / (10^309)
1306 * will fail, since 10^309 becomes infinity. In this case try to
1307 * refactor it as 123 / (10^308) etc.
1309 while (value && exponent > NV_MAX_10_EXP) {
1317 #if defined(__osf__)
1318 /* Even with cc -ieee + ieee_set_fp_control(IEEE_TRAP_ENABLE_INV)
1319 * Tru64 fp behavior on inf/nan is somewhat broken. Another way
1320 * to do this would be ieee_set_fp_control(IEEE_TRAP_ENABLE_OVF)
1321 * but that breaks another set of infnan.t tests. */
1322 # define FP_OVERFLOWS_TO_ZERO
1324 for (bit = 1; exponent; bit <<= 1) {
1325 if (exponent & bit) {
1328 #ifdef FP_OVERFLOWS_TO_ZERO
1331 return value < 0 ? -NV_INF : NV_INF;
1333 return value < 0 ? -FLT_MAX : FLT_MAX;
1336 /* Floating point exceptions are supposed to be turned off,
1337 * but if we're obviously done, don't risk another iteration.
1339 if (exponent == 0) break;
1343 return negative ? value / result : value * result;
1345 #endif /* #ifndef Perl_strtod */
1348 # define ATOF(s, x) my_atof2(s, &x)
1350 # define ATOF(s, x) Perl_atof2(s, x)
1354 Perl_my_atof(pTHX_ const char* s)
1356 /* 's' must be NUL terminated */
1360 PERL_ARGS_ASSERT_MY_ATOF;
1362 #if ! defined(USE_LOCALE_NUMERIC)
1369 DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
1370 STORE_LC_NUMERIC_SET_TO_NEEDED();
1371 if (! (PL_numeric_radix_sv && IN_LC(LC_NUMERIC))) {
1376 /* Look through the string for the first thing that looks like a
1377 * decimal point: either the value in the current locale or the
1378 * standard fallback of '.'. The one which appears earliest in the
1379 * input string is the one that we should have atof look for. Note
1380 * that we have to determine this beforehand because on some
1381 * systems, Perl_atof2 is just a wrapper around the system's atof.
1383 const char * const standard_pos = strchr(s, '.');
1384 const char * const local_pos
1385 = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
1386 const bool use_standard_radix
1387 = standard_pos && (!local_pos || standard_pos < local_pos);
1389 if (use_standard_radix) {
1390 SET_NUMERIC_STANDARD();
1391 LOCK_LC_NUMERIC_STANDARD();
1396 if (use_standard_radix) {
1397 UNLOCK_LC_NUMERIC_STANDARD();
1398 SET_NUMERIC_UNDERLYING();
1401 RESTORE_LC_NUMERIC();
1409 #if defined(NV_INF) || defined(NV_NAN)
1412 # pragma warning(push)
1413 # pragma warning(disable:4756;disable:4056)
1416 S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value)
1418 const char *p0 = negative ? s - 1 : s;
1420 const int infnan = grok_infnan(&p, send);
1421 if (infnan && p != p0) {
1422 /* If we can generate inf/nan directly, let's do so. */
1424 if ((infnan & IS_NUMBER_INFINITY)) {
1425 *value = (infnan & IS_NUMBER_NEG) ? -NV_INF: NV_INF;
1430 if ((infnan & IS_NUMBER_NAN)) {
1436 /* If still here, we didn't have either NV_INF or NV_NAN,
1437 * and can try falling back to native strtod/strtold.
1439 * The native interface might not recognize all the possible
1440 * inf/nan strings Perl recognizes. What we can try
1441 * is to try faking the input. We will try inf/-inf/nan
1442 * as the most promising/portable input. */
1444 const char* fake = "silence compiler warning";
1448 if ((infnan & IS_NUMBER_INFINITY)) {
1449 fake = ((infnan & IS_NUMBER_NEG)) ? "-inf" : "inf";
1453 if ((infnan & IS_NUMBER_NAN)) {
1457 assert(strNE(fake, "silence compiler warning"));
1458 nv = S_strtod(aTHX_ fake, &endp);
1461 if ((infnan & IS_NUMBER_INFINITY)) {
1466 /* last resort, may generate SIGFPE */
1467 *value = Perl_exp((NV)1e9);
1468 if ((infnan & IS_NUMBER_NEG))
1471 return (char*)p; /* p, not endp */
1475 if ((infnan & IS_NUMBER_NAN)) {
1480 /* last resort, may generate SIGFPE */
1481 *value = Perl_log((NV)-1.0);
1483 return (char*)p; /* p, not endp */
1488 #endif /* #ifdef Perl_strtod */
1493 # pragma warning(pop)
1496 #endif /* if defined(NV_INF) || defined(NV_NAN) */
1499 Perl_my_atof2(pTHX_ const char* orig, NV* value)
1501 PERL_ARGS_ASSERT_MY_ATOF2;
1502 return my_atof3(orig, value, 0);
1506 Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len)
1508 const char* s = orig;
1509 NV result[3] = {0.0, 0.0, 0.0};
1510 #if defined(USE_PERL_ATOF) || defined(Perl_strtod)
1511 const char* send = s + ((len != 0)
1513 : strlen(orig)); /* one past the last */
1516 #if defined(USE_PERL_ATOF) && !defined(Perl_strtod)
1517 UV accumulator[2] = {0,0}; /* before/after dp */
1518 bool seen_digit = 0;
1519 I32 exp_adjust[2] = {0,0};
1520 I32 exp_acc[2] = {-1, -1};
1521 /* the current exponent adjust for the accumulators */
1526 I32 sig_digits = 0; /* noof significant digits seen so far */
1529 #if defined(USE_PERL_ATOF) || defined(Perl_strtod)
1530 PERL_ARGS_ASSERT_MY_ATOF3;
1532 /* leading whitespace */
1533 while (s < send && isSPACE(*s))
1551 if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
1554 /* If the length is passed in, the input string isn't NUL-terminated,
1555 * and in it turns out the function below assumes it is; therefore we
1556 * create a copy and NUL-terminate that */
1558 Newx(copy, len + 1, char);
1559 Copy(orig, copy, len, char);
1561 s = copy + (s - orig);
1564 result[2] = S_strtod(aTHX_ s, &endp);
1566 /* If we created a copy, 'endp' is in terms of that. Convert back to
1569 s = (s - copy) + (char *) orig;
1570 endp = (endp - copy) + (char *) orig;
1575 *value = negative ? -result[2] : result[2];
1580 #elif defined(USE_PERL_ATOF)
1582 /* There is no point in processing more significant digits
1583 * than the NV can hold. Note that NV_DIG is a lower-bound value,
1584 * while we need an upper-bound value. We add 2 to account for this;
1585 * since it will have been conservative on both the first and last digit.
1586 * For example a 32-bit mantissa with an exponent of 4 would have
1587 * exact values in the set
1595 * where for the purposes of calculating NV_DIG we would have to discount
1596 * both the first and last digit, since neither can hold all values from
1597 * 0..9; but for calculating the value we must examine those two digits.
1599 #ifdef MAX_SIG_DIG_PLUS
1600 /* It is not necessarily the case that adding 2 to NV_DIG gets all the
1601 possible digits in a NV, especially if NVs are not IEEE compliant
1602 (e.g., long doubles on IRIX) - Allen <allens@cpan.org> */
1603 # define MAX_SIG_DIGITS (NV_DIG+MAX_SIG_DIG_PLUS)
1605 # define MAX_SIG_DIGITS (NV_DIG+2)
1608 /* the max number we can accumulate in a UV, and still safely do 10*N+9 */
1609 #define MAX_ACCUMULATE ( (UV) ((UV_MAX - 9)/10))
1611 #if defined(NV_INF) || defined(NV_NAN)
1614 if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
1619 /* we accumulate digits into an integer; when this becomes too
1620 * large, we add the total to NV and start again */
1630 /* don't start counting until we see the first significant
1631 * digit, eg the 5 in 0.00005... */
1632 if (!sig_digits && digit == 0)
1635 if (++sig_digits > MAX_SIG_DIGITS) {
1636 /* limits of precision reached */
1638 ++accumulator[seen_dp];
1639 } else if (digit == 5) {
1640 if (old_digit % 2) { /* round to even - Allen */
1641 ++accumulator[seen_dp];
1649 /* skip remaining digits */
1650 while (s < send && isDIGIT(*s)) {
1656 /* warn of loss of precision? */
1659 if (accumulator[seen_dp] > MAX_ACCUMULATE) {
1660 /* add accumulator to result and start again */
1661 result[seen_dp] = S_mulexp10(result[seen_dp],
1663 + (NV)accumulator[seen_dp];
1664 accumulator[seen_dp] = 0;
1665 exp_acc[seen_dp] = 0;
1667 accumulator[seen_dp] = accumulator[seen_dp] * 10 + digit;
1671 else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) {
1673 if (sig_digits > MAX_SIG_DIGITS) {
1674 while (s < send && isDIGIT(*s)) {
1685 result[0] = S_mulexp10(result[0], exp_acc[0]) + (NV)accumulator[0];
1687 result[1] = S_mulexp10(result[1], exp_acc[1]) + (NV)accumulator[1];
1690 if (s < send && seen_digit && (isALPHA_FOLD_EQ(*s, 'e'))) {
1691 bool expnegative = 0;
1701 while (s < send && isDIGIT(*s))
1702 exponent = exponent * 10 + (*s++ - '0');
1704 exponent = -exponent;
1707 /* now apply the exponent */
1710 result[2] = S_mulexp10(result[0],exponent+exp_adjust[0])
1711 + S_mulexp10(result[1],exponent-exp_adjust[1]);
1713 result[2] = S_mulexp10(result[0],exponent+exp_adjust[0]);
1716 /* now apply the sign */
1718 result[2] = -result[2];
1719 #endif /* USE_PERL_ATOF */
1725 =for apidoc isinfnan
1727 C<Perl_isinfnan()> is utility function that returns true if the NV
1728 argument is either an infinity or a C<NaN>, false otherwise. To test
1729 in more detail, use C<Perl_isinf()> and C<Perl_isnan()>.
1731 This is also the logical inverse of Perl_isfinite().
1736 Perl_isinfnan(NV nv)
1738 PERL_UNUSED_ARG(nv);
1753 Checks whether the argument would be either an infinity or C<NaN> when used
1754 as a number, but is careful not to trigger non-numeric or uninitialized
1755 warnings. it assumes the caller has done C<SvGETMAGIC(sv)> already.
1761 Perl_isinfnansv(pTHX_ SV *sv)
1763 PERL_ARGS_ASSERT_ISINFNANSV;
1767 return Perl_isinfnan(SvNVX(sv));
1772 const char *s = SvPV_nomg_const(sv, len);
1773 return cBOOL(grok_infnan(&s, s+len));
1778 /* C99 has truncl, pre-C99 Solaris had aintl. We can use either with
1779 * copysignl to emulate modfl, which is in some platforms missing or
1781 # if defined(HAS_TRUNCL) && defined(HAS_COPYSIGNL)
1783 Perl_my_modfl(long double x, long double *ip)
1786 return (x == *ip ? copysignl(0.0L, x) : x - *ip);
1788 # elif defined(HAS_AINTL) && defined(HAS_COPYSIGNL)
1790 Perl_my_modfl(long double x, long double *ip)
1793 return (x == *ip ? copysignl(0.0L, x) : x - *ip);
1798 /* Similarly, with ilogbl and scalbnl we can emulate frexpl. */
1799 #if ! defined(HAS_FREXPL) && defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
1801 Perl_my_frexpl(long double x, int *e) {
1802 *e = x == 0.0L ? 0 : ilogbl(x) + 1;
1803 return (scalbnl(x, -*e));
1808 =for apidoc Perl_signbit
1810 Return a non-zero integer if the sign bit on an NV is set, and 0 if
1813 If F<Configure> detects this system has a C<signbit()> that will work with
1814 our NVs, then we just use it via the C<#define> in F<perl.h>. Otherwise,
1815 fall back on this implementation. The main use of this function
1816 is catching C<-0.0>.
1818 C<Configure> notes: This function is called C<'Perl_signbit'> instead of a
1819 plain C<'signbit'> because it is easy to imagine a system having a C<signbit()>
1820 function or macro that doesn't happen to work with our particular choice
1821 of NVs. We shouldn't just re-C<#define> C<signbit> as C<Perl_signbit> and expect
1822 the standard system headers to be happy. Also, this is a no-context
1823 function (no C<pTHX_>) because C<Perl_signbit()> is usually re-C<#defined> in
1824 F<perl.h> as a simple macro call to the system's C<signbit()>.
1825 Users should just always call C<Perl_signbit()>.
1829 #if !defined(HAS_SIGNBIT)
1831 Perl_signbit(NV x) {
1832 # ifdef Perl_fp_class_nzero
1833 return Perl_fp_class_nzero(x);
1834 /* Try finding the high byte, and assume it's highest bit
1835 * is the sign. This assumption is probably wrong somewhere. */
1836 # elif defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
1837 return (((unsigned char *)&x)[9] & 0x80);
1838 # elif defined(NV_LITTLE_ENDIAN)
1839 /* Note that NVSIZE is sizeof(NV), which would make the below be
1840 * wrong if the end bytes are unused, which happens with the x86
1841 * 80-bit long doubles, which is why take care of that above. */
1842 return (((unsigned char *)&x)[NVSIZE - 1] & 0x80);
1843 # elif defined(NV_BIG_ENDIAN)
1844 return (((unsigned char *)&x)[0] & 0x80);
1846 /* This last resort fallback is wrong for the negative zero. */
1847 return (x < 0.0) ? 1 : 0;
1853 * ex: set ts=8 sts=4 sw=4 et: