Mainly to avoid Inf and NaN, which VAX does does not have.
There is something like Inf called "excess" but that is
a deadly exception, seems to manifest itself in vax-netbsd
either as a SIGFPE or SIGSEGV (pretty much untrappable at
least from Perl level).
The range of VAX floats is different from IEEE.
There is positive zero, but no negative zero.
* 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.
return x;
}
+#if defined(NV_INF) || defined(NV_NAN)
#ifdef USING_MSVC6
# pragma warning(push)
/* 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)
{
* Also, do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF).
* Though logically correct, some compilers (like Visual C 2003)
* falsely misoptimize that to zero (x-x is always zero, right?)
+ *
+ * Finally, note that not all floating point formats define Inf (or NaN).
+ * For the infinity a large number may be used instead. Operations that
+ * under the IEEE floating point would return Inf or NaN may return
+ * either large numbers (positive or negative), or they may cause
+ * a floating point exception or some other fault.
*/
/* The quadmath literals are anon structs which -Wc++-compat doesn't like. */
#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII
+#if DOUBLEKIND == DOUBLE_IS_VAX_F_FLOAT || \
+ DOUBLEKIND == DOUBLE_IS_VAX_D_FLOAT || \
+ DOUBLEKIND == DOUBLE_IS_VAX_G_FLOAT
+# define DOUBLE_IS_VAX_FLOAT
+#else
+# define DOUBLE_IS_IEEE_FORMAT
+#endif
+
#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN || \
DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN || \
DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
# define DOUBLE_MIX_ENDIAN
#endif
+/* Even though the VAX formats are kind of little-endian,
+ * they are not really fully little-endian like Intel IEEE,
+ * but neither they are really IEEE-mixed endian like the
+ * mixed-endian ARM IEEE formats (with swapped bytes).
+ * The VAX format ultimately come from PDP. */
+
+#ifdef DOUBLE_IS_VAX_FLOAT
+# define DOUBLE_VAX_ENDIAN
+#endif
+
+#ifdef DOUBLE_IS_IEEE_FORMAT
/* All the basic IEEE formats have the implicit bit,
* except for the 80-bit extended formats, which will undef this. */
-#define NV_IMPLICIT_BIT
+# define NV_IMPLICIT_BIT
+#endif
-#ifdef LONG_DOUBLEKIND
+#if defined(LONG_DOUBLEKIND) && LONG_DOUBLEKIND != LONG_DOUBLE_IS_DOUBLE
# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \
LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
# ifdef DOUBLE_MIX_ENDIAN
# define NV_MIX_ENDIAN
# endif
+# ifdef DOUBLE_VAX_ENDIAN
+# define NV_VAX_ENDIAN
+# endif
#elif NVSIZE == LONG_DOUBLESIZE
# ifdef LONGDOUBLE_LITTLE_ENDIAN
# define NV_LITTLE_ENDIAN
# endif
#endif
+#ifdef DOUBLE_IS_IEEE_FORMAT
+# define DOUBLE_HAS_INF
+# define DOUBLE_HAS_NAN
+#endif
+
+#ifdef DOUBLE_HAS_NAN
+
/* NaNs (not-a-numbers) can carry payload bits, in addition to
* "nan-ness". Part of the payload is the quiet/signaling bit.
* To back up a bit (harhar):
# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE
# define NV_NAN_QS_BYTE_OFFSET 5 /* bytes 3 2 1 0 7 6 5 4 (MSB 7) */
# else
+/* For example the VAX formats should never
+ * get here because they do not have NaN. */
# error "Unexpected double format"
# endif
#endif
# error "Unexpected double format"
# endif
#endif
+
+#endif /* DOUBLE_HAS_NAN */
+
/*
(KEEP THIS LAST IN perl.h!)
NV anv;
fromstr = NEXTFROM;
anv = SvNV(fromstr);
-# if defined(VMS) && !defined(_IEEE_FP)
+# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT)
/* IEEE fp overflow shenanigans are unavailable on VAX and optional
* on Alpha; fake it if we don't have them.
*/
afloat = -FLT_MAX;
else afloat = (float)anv;
# else
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+# if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
if(Perl_isnan(anv))
afloat = (float)NV_NAN;
else
-#endif
+# endif
+# ifdef NV_INF
/* a simple cast to float is undefined if outside
* the range of values that can be represented */
afloat = (float)(anv > FLT_MAX ? NV_INF :
anv < -FLT_MAX ? -NV_INF : anv);
+# endif
# endif
PUSH_VAR(utf8, cur, afloat, needs_swap);
}
NV anv;
fromstr = NEXTFROM;
anv = SvNV(fromstr);
-# if defined(VMS) && !defined(_IEEE_FP)
+# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT)
/* IEEE fp overflow shenanigans are unavailable on VAX and optional
* on Alpha; fake it if we don't have them.
*/
{
bool pok = cBOOL(SvPOK(sv));
bool nok = FALSE;
+#ifdef NV_INF
if ((numtype & IS_NUMBER_INFINITY)) {
SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -NV_INF : NV_INF);
nok = TRUE;
- }
- else if ((numtype & IS_NUMBER_NAN)) {
+ } else
+#endif
+#ifdef NV_NAN
+ if ((numtype & IS_NUMBER_NAN)) {
SvNV_set(sv, NV_NAN);
nok = TRUE;
- }
- else if (pok) {
+ } else
+#endif
+ if (pok) {
SvNV_set(sv, Atof(SvPVX_const(sv)));
/* Purposefully no true nok here, since we don't want to blow
* away the possible IOK/UV of an existing sv. */