VAX: code changes for VAX floats

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.

diff --git a/numeric.c b/numeric.c
index f645502..5fc3df3 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -1138,7 +1138,7 @@ S_mulexp10(NV value, I32 exponent)
      * 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)
@@ -1185,7 +1185,11 @@ S_mulexp10(NV value, I32 exponent)
            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.  
@@ -1247,6 +1251,7 @@ Perl_my_atof(pTHX_ const char* s)
     return x;
 }
 
+#if defined(NV_INF) || defined(NV_NAN)
 
 #ifdef USING_MSVC6
 #  pragma warning(push)
@@ -1276,8 +1281,6 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
         /* 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
@@ -1286,36 +1289,44 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
             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
                 }
             }
         }
@@ -1327,6 +1338,8 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
 #  pragma warning(pop)
 #endif
 
+#endif /* if defined(NV_INF) || defined(NV_NAN) */
+
 char*
 Perl_my_atof2(pTHX_ const char* orig, NV* value)
 {

diff --git a/perl.h b/perl.h
index a1dae95..3cb9739 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5736,6 +5736,12 @@ EXTCONST bool PL_valid_types_NV_set[];
  * 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. */
@@ -6743,6 +6749,14 @@ extern void moncontrol(int);
 #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
@@ -6760,11 +6774,23 @@ extern void moncontrol(int);
 #  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 || \
@@ -6818,6 +6844,9 @@ extern void moncontrol(int);
 #  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
@@ -6830,6 +6859,13 @@ extern void moncontrol(int);
 #  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):
@@ -6980,6 +7016,8 @@ extern void moncontrol(int);
 #  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
@@ -7182,6 +7220,9 @@ extern void moncontrol(int);
 #    error "Unexpected double format"
 #  endif
 #endif
+
+#endif /* DOUBLE_HAS_NAN */
+
 /*
 
    (KEEP THIS LAST IN perl.h!)

diff --git a/pp_pack.c b/pp_pack.c
index f6964c3..891d2e2 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2674,7 +2674,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                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.
                 */
@@ -2684,15 +2684,17 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    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);
            }
@@ -2703,7 +2705,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                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.
                 */

diff --git a/sv.c b/sv.c
index 2ceec5a..1e294dd 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2097,15 +2097,19 @@ S_sv_setnv(pTHX_ SV* sv, int numtype)
 {
     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. */