This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add testing framework for boolean context
[perl5.git] / perl.h
diff --git a/perl.h b/perl.h
index 27afddb..d832db4 100644 (file)
--- a/perl.h
+++ b/perl.h
 #   include "config.h"
 #endif
 
+/* this is used for functions which take a depth trailing
+ * argument under debugging */
+#ifdef DEBUGGING
+#define _pDEPTH ,U32 depth
+#define _aDEPTH ,depth
+#else
+#define _pDEPTH
+#define _aDEPTH
+#endif
+
 /* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined
  * because the __STDC_VERSION__ became a thing only with C90.  Therefore,
  * with gcc, HAS_C99 will never become true as long as we use -std=c89.
  * or variables/arguments that are used only in certain configurations.
  */
 #ifndef PERL_UNUSED_ARG
-#  if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
-#    include <note.h>
-#    define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
-#  else
-#    define PERL_UNUSED_ARG(x) ((void)sizeof(x))
-#  endif
+#  define PERL_UNUSED_ARG(x) ((void)sizeof(x))
 #endif
 #ifndef PERL_UNUSED_VAR
 #  define PERL_UNUSED_VAR(x) ((void)sizeof(x))
 #  define GCC_DIAG_IGNORE(w)
 #  define GCC_DIAG_RESTORE
 #endif
+/* for clang specific pragmas */
+#if defined(__clang__) || defined(__clang)
+#  define CLANG_DIAG_PRAGMA(x) _Pragma (#x)
+#  define CLANG_DIAG_IGNORE(x) _Pragma("clang diagnostic push") \
+                               CLANG_DIAG_PRAGMA(clang diagnostic ignored #x)
+#  define CLANG_DIAG_RESTORE   _Pragma("clang diagnostic pop")
+#else
+#  define CLANG_DIAG_IGNORE(w)
+#  define CLANG_DIAG_RESTORE
+#endif
 
 #define NOOP /*EMPTY*/(void)0
 /* cea2e8a9dd23747f accidentally lost the comment originally from the first
 #   define TAINT_WARN_get       0
 #   define TAINT_WARN_set(s)    NOOP
 #else
-#   define TAINT               (PL_tainted = TRUE)
+#   define TAINT               (PL_tainted = PL_tainting)
 #   define TAINT_NOT   (PL_tainted = FALSE)
-#   define TAINT_IF(c) if (UNLIKELY(c)) { PL_tainted = TRUE; }
+#   define TAINT_IF(c) if (UNLIKELY(c)) { PL_tainted = PL_tainting; }
 #   define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); }
 #   define TAINT_PROPER(s)     if (UNLIKELY(PL_tainting)) { taint_proper(NULL, s); }
 #   define TAINT_set(s)                (PL_tainted = (s))
 #   include <locale.h>
 #endif
 
+#ifdef I_XLOCALE
+#   include <xlocale.h>
+#endif
+
 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
 #   define USE_LOCALE
 #   define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
 #   endif
 #endif /* !NO_LOCALE && HAS_SETLOCALE */
 
-/* Is $^ENCODING set, or are we under the encoding pragma? */
-#define IN_ENCODING UNLIKELY(PL_encoding                                      \
-                             || (PL_lex_encoding && _get_encoding() != NULL))
-
 #include <setjmp.h>
 
 #ifdef I_SYS_PARAM
@@ -997,11 +1012,7 @@ EXTERN_C int usleep(unsigned int);
 #  endif
 #else
 #   ifndef memcpy
-#      ifdef HAS_BCOPY
-#          define memcpy(d,s,l) bcopy(s,d,l)
-#      else
-#          define memcpy(d,s,l) my_bcopy(s,d,l)
-#      endif
+#      define memcpy(d,s,l) my_bcopy(s,d,l)
 #   endif
 #endif /* HAS_MEMCPY */
 
@@ -1017,14 +1028,10 @@ EXTERN_C int usleep(unsigned int);
 #endif /* HAS_MEMSET */
 
 #if !defined(HAS_MEMMOVE) && !defined(memmove)
-#   if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
-#      define memmove(d,s,l) bcopy(s,d,l)
+#   if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
+#      define memmove(d,s,l) memcpy(d,s,l)
 #   else
-#      if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
-#          define memmove(d,s,l) memcpy(d,s,l)
-#      else
-#          define memmove(d,s,l) my_bcopy(s,d,l)
-#      endif
+#      define memmove(d,s,l) my_bcopy(s,d,l)
 #   endif
 #endif
 
@@ -1039,9 +1046,8 @@ EXTERN_C int usleep(unsigned int);
 #    endif
 #  endif
 #else
-#   ifndef memcmp
-#      define memcmp   my_memcmp
-#   endif
+#   undef memcmp
+#   define memcmp   my_memcmp
 #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
 
 #ifndef memzero
@@ -1269,14 +1275,13 @@ EXTERN_C char *crypt(const char *, const char *);
 #define CLEAR_ERRSV() STMT_START {                                     \
     SV ** const svp = &GvSV(PL_errgv);                                 \
     if (!*svp) {                                                       \
-       goto clresv_newemptypv;                                         \
+        *svp = newSVpvs("");                                            \
     } else if (SvREADONLY(*svp)) {                                     \
        SvREFCNT_dec_NN(*svp);                                          \
-       clresv_newemptypv:                                              \
        *svp = newSVpvs("");                                            \
     } else {                                                           \
        SV *const errsv = *svp;                                         \
-       sv_setpvs(errsv, "");                                           \
+        SvPVCLEAR(errsv);                                               \
        SvPOK_only(errsv);                                              \
        if (SvMAGICAL(errsv)) {                                         \
            mg_free(errsv);                                             \
@@ -1868,6 +1873,9 @@ typedef NVTYPE NV;
 /* Also Tru64 cc has broken NaN comparisons. */
 #  define NAN_COMPARE_BROKEN
 #endif
+#if defined(__sgi)
+#  define NAN_COMPARE_BROKEN
+#endif
 
 #ifdef USE_LONG_DOUBLE
 #   ifdef I_SUNMATH
@@ -2017,6 +2025,12 @@ extern long double Perl_my_frexpl(long double x, int *e);
 #   define Perl_isinf(x) isinfq(x)
 #   define Perl_isnan(x) isnanq(x)
 #   define Perl_isfinite(x) !(isnanq(x) || isinfq(x))
+#   define Perl_fp_class(x) ((x) == 0.0Q ? 0 : isinfq(x) ? 3 : isnanq(x) ? 4 : PERL_ABS(x) < FLT128_MIN ? 2 : 1)
+#   define Perl_fp_class_inf(x)    (Perl_fp_class(x) == 3)
+#   define Perl_fp_class_nan(x)    (Perl_fp_class(x) == 4)
+#   define Perl_fp_class_norm(x)   (Perl_fp_class(x) == 1)
+#   define Perl_fp_class_denorm(x) (Perl_fp_class(x) == 2)
+#   define Perl_fp_class_zero(x)   (Perl_fp_class(x) == 0)
 #else
 #   define NV_DIG DBL_DIG
 #   ifdef DBL_MANT_DIG
@@ -2661,6 +2675,11 @@ typedef AV PAD;
 typedef struct padnamelist PADNAMELIST;
 typedef struct padname PADNAME;
 
+/* enable PERL_OP_PARENT by default */
+#if !defined(PERL_OP_PARENT) && !defined(PERL_NO_OP_PARENT)
+#  define PERL_OP_PARENT
+#endif
+
 /* enable PERL_COPY_ON_WRITE by default */
 #if !defined(PERL_COPY_ON_WRITE) && !defined(PERL_NO_COW)
 #  define PERL_COPY_ON_WRITE
@@ -3049,6 +3068,105 @@ freeing any remaining Perl interpreters.
  * May make sense to have threads after "*ish.h" anyway
  */
 
+/* clang Thread Safety Analysis/Annotations/Attributes
+ * http://clang.llvm.org/docs/ThreadSafetyAnalysis.html
+ *
+ * Available since clang 3.6-ish (appeared in 3.4, but shaky still in 3.5).
+ * Apple XCode hijacks __clang_major__ and __clang_minor__
+ * (6.1 means really clang 3.6), so needs extra hijinks
+ * (could probably also test the contents of __apple_build_version__).
+ */
+#if defined(USE_ITHREADS) && defined(I_PTHREAD) && \
+    defined(__clang__) && \
+    !defined(PERL_GLOBAL_STRUCT) && \
+    !defined(PERL_GLOBAL_STRUCT_PRIVATE) && \
+    !defined(SWIG) && \
+  ((!defined(__apple_build_version__) &&               \
+    ((__clang_major__ == 3 && __clang_minor__ >= 6) || \
+     (__clang_major__ >= 4))) || \
+   (defined(__apple_build_version__) &&                \
+    ((__clang_major__ == 6 && __clang_minor__ >= 1) || \
+     (__clang_major__ >= 7))))
+#  define PERL_TSA__(x)   __attribute__((x))
+#  define PERL_TSA_ACTIVE
+#else
+#  define PERL_TSA__(x)   /* No TSA, make TSA attributes no-ops. */
+#  undef PERL_TSA_ACTIVE
+#endif
+
+/* PERL_TSA_CAPABILITY() is used to annotate typedefs.
+ * typedef old_type PERL_TSA_CAPABILITY("mutex") new_type;
+ */
+#define PERL_TSA_CAPABILITY(x) \
+    PERL_TSA__(capability(x))
+
+/* In the below examples the mutex must be lexically visible, usually
+ * either as global variables, or as function arguments. */
+
+/* PERL_TSA_GUARDED_BY() is used to annotate global variables.
+ *
+ * Foo foo PERL_TSA_GUARDED_BY(mutex);
+ */
+#define PERL_TSA_GUARDED_BY(x) \
+    PERL_TSA__(guarded_by(x))
+
+/* PERL_TSA_PT_GUARDED_BY() is used to annotate global pointers.
+ * The data _behind_ the pointer is guarded.
+ *
+ * Foo* ptr PERL_TSA_PT_GUARDED_BY(mutex);
+ */
+#define PERL_TSA_PT_GUARDED_BY(x) \
+    PERL_TSA__(pt_guarded_by(x))
+
+/* PERL_TSA_REQUIRES() is used to annotate functions.
+ * The caller MUST hold the resource when calling the function.
+ *
+ * void Foo() PERL_TSA_REQUIRES(mutex);
+ */
+#define PERL_TSA_REQUIRES(x) \
+    PERL_TSA__(requires_capability(x))
+
+/* PERL_TSA_EXCLUDES() is used to annotate functions.
+ * The caller MUST NOT hold resource when calling the function.
+ *
+ * EXCLUDES should be used when the function first acquires
+ * the resource and then releases it.  Use to avoid deadlock.
+ *
+ * void Foo() PERL_TSA_EXCLUDES(mutex);
+ */
+#define PERL_TSA_EXCLUDES(x) \
+    PERL_TSA__(locks_excluded(x))
+
+/* PERL_TSA_ACQUIRE() is used to annotate functions.
+ * The caller MUST NOT hold the resource when calling the function,
+ * and the function will acquire the resource.
+ *
+ * void Foo() PERL_TSA_ACQUIRE(mutex);
+ */
+#define PERL_TSA_ACQUIRE(x) \
+    PERL_TSA__(acquire_capability(x))
+
+/* PERL_TSA_RELEASE() is used to annotate functions.
+ * The caller MUST hold the resource when calling the function,
+ * and the function will release the resource.
+ *
+ * void Foo() PERL_TSA_RELEASE(mutex);
+ */
+#define PERL_TSA_RELEASE(x) \
+    PERL_TSA__(release_capability(x))
+
+/* PERL_TSA_NO_TSA is used to annotate functions.
+ * Used when being intentionally unsafe, or when the code is too
+ * complicated for the analysis.  Use sparingly.
+ *
+ * void Foo() PERL_TSA_NO_TSA;
+ */
+#define PERL_TSA_NO_TSA \
+    PERL_TSA__(no_thread_safety_analysis)
+
+/* There are more annotations/attributes available, see the clang
+ * documentation for details. */
+
 #if defined(USE_ITHREADS)
 #  ifdef NETWARE
 #   include <nw5thread.h>
@@ -3070,7 +3188,7 @@ typedef void *            perl_key;
 #            include <pthread.h>
 #          endif
 typedef pthread_t      perl_os_thread;
-typedef pthread_mutex_t        perl_mutex;
+typedef pthread_mutex_t PERL_TSA_CAPABILITY("mutex") perl_mutex;
 typedef pthread_cond_t perl_cond;
 typedef pthread_key_t  perl_key;
 #        endif /* I_MACH_CTHREADS */
@@ -3079,6 +3197,25 @@ typedef pthread_key_t    perl_key;
 #  endif /* NETWARE */
 #endif /* USE_ITHREADS */
 
+#ifdef PERL_TSA_ACTIVE
+/* Since most pthread mutex interfaces have not been annotated, we
+ * need to have these wrappers. The NO_TSA annotation is quite ugly
+ * but it cannot be avoided in plain C, unlike in C++, where one could
+ * e.g. use ACQUIRE() with no arg on a mutex lock method.
+ *
+ * The bodies of these wrappers are in util.c
+ *
+ * TODO: however, some platforms are starting to get these clang
+ * thread safety annotations for pthreads, for example FreeBSD.
+ * Do we need a way to a bypass these wrappers? */
+EXTERN_C int perl_tsa_mutex_lock(perl_mutex* mutex)
+  PERL_TSA_ACQUIRE(*mutex)
+  PERL_TSA_NO_TSA;
+EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex)
+  PERL_TSA_RELEASE(*mutex)
+  PERL_TSA_NO_TSA;
+#endif
+
 #if defined(WIN32)
 #  include "win32.h"
 #endif
@@ -3668,6 +3805,14 @@ UNION_ANY_DEFINITION;
 #else
 union any {
     void*      any_ptr;
+    SV*         any_sv;
+    SV**        any_svp;
+    GV*         any_gv;
+    AV*         any_av;
+    HV*         any_hv;
+    OP*         any_op;
+    char*       any_pv;
+    char**      any_pvp;
     I32                any_i32;
     U32                any_u32;
     IV         any_iv;
@@ -3751,12 +3896,6 @@ typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
 #  define USE_HASH_SEED
 #endif
 
-/* Win32 defines a type 'WORD' in windef.h, and AmigaOS in exec/types.h.
- * This conflicts with the enumerator 'WORD' defined in perly.h.
- * The yytokentype enum is only a debugging aid, so it's not really needed. */
-#if defined(WIN32) || defined(__amigaos4__)
-#  define YYTOKENTYPE
-#endif
 #include "perly.h"
 
 
@@ -3797,14 +3936,6 @@ typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
 #undef _XPVMG_HEAD
 #undef _XPVCV_COMMON
 
-typedef struct _sublex_info SUBLEXINFO;
-struct _sublex_info {
-    U8 super_state;    /* lexer state to save */
-    U16 sub_inwhat;    /* "lex_inwhat" to use */
-    OP *sub_op;                /* "lex_op" to use */
-    SV *repl;          /* replacement of s/// or y/// */
-};
-
 #include "parser.h"
 
 typedef struct magic_state MGS;        /* struct magic_state defined in mg.c */
@@ -4050,38 +4181,40 @@ Gid_t getegid (void);
 #define DEBUG_M_FLAG           0x01000000 /*16777216*/
 #define DEBUG_B_FLAG           0x02000000 /*33554432*/
 #define DEBUG_L_FLAG           0x04000000 /*67108864*/
-#define DEBUG_MASK             0x07FFEFFF /* mask of all the standard flags */
+#define DEBUG_i_FLAG           0x08000000 /*134217728*/
+#define DEBUG_MASK             0x0FFFEFFF /* mask of all the standard flags */
 
 #define DEBUG_DB_RECURSE_FLAG  0x40000000
 #define DEBUG_TOP_FLAG         0x80000000 /* -D was given --> PL_debug |= FLAG */
 
-#  define DEBUG_p_TEST_ (PL_debug & DEBUG_p_FLAG)
-#  define DEBUG_s_TEST_ (PL_debug & DEBUG_s_FLAG)
-#  define DEBUG_l_TEST_ (PL_debug & DEBUG_l_FLAG)
-#  define DEBUG_t_TEST_ (PL_debug & DEBUG_t_FLAG)
-#  define DEBUG_o_TEST_ (PL_debug & DEBUG_o_FLAG)
-#  define DEBUG_c_TEST_ (PL_debug & DEBUG_c_FLAG)
-#  define DEBUG_P_TEST_ (PL_debug & DEBUG_P_FLAG)
-#  define DEBUG_m_TEST_ (PL_debug & DEBUG_m_FLAG)
-#  define DEBUG_f_TEST_ (PL_debug & DEBUG_f_FLAG)
-#  define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG)
-#  define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG)
-#  define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG)
-#  define DEBUG_U_TEST_ (PL_debug & DEBUG_U_FLAG)
-#  define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG)
-#  define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG)
-#  define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG)
-#  define DEBUG_S_TEST_ (PL_debug & DEBUG_S_FLAG)
-#  define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG)
-#  define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
-#  define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
-#  define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG)
-#  define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG)
-#  define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG)
-#  define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
-#  define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG)
-#  define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG)
-#  define DEBUG_L_TEST_ (PL_debug & DEBUG_L_FLAG)
+#  define DEBUG_p_TEST_ UNLIKELY(PL_debug & DEBUG_p_FLAG)
+#  define DEBUG_s_TEST_ UNLIKELY(PL_debug & DEBUG_s_FLAG)
+#  define DEBUG_l_TEST_ UNLIKELY(PL_debug & DEBUG_l_FLAG)
+#  define DEBUG_t_TEST_ UNLIKELY(PL_debug & DEBUG_t_FLAG)
+#  define DEBUG_o_TEST_ UNLIKELY(PL_debug & DEBUG_o_FLAG)
+#  define DEBUG_c_TEST_ UNLIKELY(PL_debug & DEBUG_c_FLAG)
+#  define DEBUG_P_TEST_ UNLIKELY(PL_debug & DEBUG_P_FLAG)
+#  define DEBUG_m_TEST_ UNLIKELY(PL_debug & DEBUG_m_FLAG)
+#  define DEBUG_f_TEST_ UNLIKELY(PL_debug & DEBUG_f_FLAG)
+#  define DEBUG_r_TEST_ UNLIKELY(PL_debug & DEBUG_r_FLAG)
+#  define DEBUG_x_TEST_ UNLIKELY(PL_debug & DEBUG_x_FLAG)
+#  define DEBUG_u_TEST_ UNLIKELY(PL_debug & DEBUG_u_FLAG)
+#  define DEBUG_U_TEST_ UNLIKELY(PL_debug & DEBUG_U_FLAG)
+#  define DEBUG_H_TEST_ UNLIKELY(PL_debug & DEBUG_H_FLAG)
+#  define DEBUG_X_TEST_ UNLIKELY(PL_debug & DEBUG_X_FLAG)
+#  define DEBUG_D_TEST_ UNLIKELY(PL_debug & DEBUG_D_FLAG)
+#  define DEBUG_S_TEST_ UNLIKELY(PL_debug & DEBUG_S_FLAG)
+#  define DEBUG_T_TEST_ UNLIKELY(PL_debug & DEBUG_T_FLAG)
+#  define DEBUG_R_TEST_ UNLIKELY(PL_debug & DEBUG_R_FLAG)
+#  define DEBUG_J_TEST_ UNLIKELY(PL_debug & DEBUG_J_FLAG)
+#  define DEBUG_v_TEST_ UNLIKELY(PL_debug & DEBUG_v_FLAG)
+#  define DEBUG_C_TEST_ UNLIKELY(PL_debug & DEBUG_C_FLAG)
+#  define DEBUG_A_TEST_ UNLIKELY(PL_debug & DEBUG_A_FLAG)
+#  define DEBUG_q_TEST_ UNLIKELY(PL_debug & DEBUG_q_FLAG)
+#  define DEBUG_M_TEST_ UNLIKELY(PL_debug & DEBUG_M_FLAG)
+#  define DEBUG_B_TEST_ UNLIKELY(PL_debug & DEBUG_B_FLAG)
+#  define DEBUG_L_TEST_ UNLIKELY(PL_debug & DEBUG_L_FLAG)
+#  define DEBUG_i_TEST_ UNLIKELY(PL_debug & DEBUG_i_FLAG)
 #  define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
 #  define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_)
 #  define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_)
@@ -4116,6 +4249,7 @@ Gid_t getegid (void);
 #  define DEBUG_M_TEST DEBUG_M_TEST_
 #  define DEBUG_B_TEST DEBUG_B_TEST_
 #  define DEBUG_L_TEST DEBUG_L_TEST_
+#  define DEBUG_i_TEST DEBUG_i_TEST_
 #  define DEBUG_Xv_TEST DEBUG_Xv_TEST_
 #  define DEBUG_Uv_TEST DEBUG_Uv_TEST_
 #  define DEBUG_Pv_TEST DEBUG_Pv_TEST_
@@ -4135,21 +4269,30 @@ Gid_t getegid (void);
      /* Temporarily turn off memory debugging in case the a
       * does memory allocation, either directly or indirectly. */
 #  define DEBUG_m(a)  \
-    STMT_START {                                                       \
-        if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \
+    STMT_START {                                                       \
+        if (PERL_GET_INTERP) {                                          \
+                                dTHX;                                   \
+                                if (DEBUG_m_TEST) {                     \
+                                    PL_debug &= ~DEBUG_m_FLAG;          \
+                                    a;                                  \
+                                    PL_debug |= DEBUG_m_FLAG;           \
+                                }                                       \
+                              }                                         \
     } STMT_END
 
-#  define DEBUG__(t, a) \
-       STMT_START { \
-               if (t) STMT_START {a;} STMT_END; \
-       } STMT_END
+#  define DEBUG__(t, a)                                                 \
+        STMT_START {                                                    \
+                if (t) STMT_START {a;} STMT_END;                        \
+        } STMT_END
 
 #  define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
+
 #ifndef PERL_EXT_RE_BUILD
 #  define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
 #else
 #  define DEBUG_r(a) STMT_START {a;} STMT_END
 #endif /* PERL_EXT_RE_BUILD */
+
 #  define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
 #  define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
 #  define DEBUG_U(a) DEBUG__(DEBUG_U_TEST, a)
@@ -4171,6 +4314,7 @@ Gid_t getegid (void);
 #  define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a)
 #  define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a)
 #  define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a)
+#  define DEBUG_i(a) DEBUG__(DEBUG_i_TEST, a)
 
 #else /* DEBUGGING */
 
@@ -4201,6 +4345,7 @@ Gid_t getegid (void);
 #  define DEBUG_M_TEST (0)
 #  define DEBUG_B_TEST (0)
 #  define DEBUG_L_TEST (0)
+#  define DEBUG_i_TEST (0)
 #  define DEBUG_Xv_TEST (0)
 #  define DEBUG_Uv_TEST (0)
 #  define DEBUG_Pv_TEST (0)
@@ -4235,6 +4380,7 @@ Gid_t getegid (void);
 #  define DEBUG_M(a)
 #  define DEBUG_B(a)
 #  define DEBUG_L(a)
+#  define DEBUG_i(a)
 #  define DEBUG_Xv(a)
 #  define DEBUG_Uv(a)
 #  define DEBUG_Pv(a)
@@ -4981,10 +5127,11 @@ EXTCONST char* const PL_block_type[] = {
        "WHEN",
        "BLOCK",
        "GIVEN",
-       "LOOP_FOR",
-       "LOOP_PLAIN",
+       "LOOP_ARY",
        "LOOP_LAZYSV",
        "LOOP_LAZYIV",
+       "LOOP_LIST",
+       "LOOP_PLAIN",
        "SUB",
        "FORMAT",
        "EVAL",
@@ -4996,7 +5143,7 @@ EXTCONST char* PL_block_type[];
 
 /* These are all the compile time options that affect binary compatibility.
    Other compile time options that are binary compatible are in perl.c
-   Both are combined for the output of perl -V
+   (in S_Internals_V()). Both are combined for the output of perl -V
    However, this string will be embedded in any shared perl library, which will
    allow us add a comparison check in perlmain.c in the near future.  */
 #ifdef DOINIT
@@ -5119,7 +5266,7 @@ EXTCONST char PL_bincompat_options[];
 
 #ifndef PERL_SET_PHASE
 #  define PERL_SET_PHASE(new_phase) \
-    PHASE_CHANGE_PROBE(PL_phase_names[new_phase], PL_phase_names[PL_phase]); \
+    PERL_DTRACE_PROBE_PHASE(new_phase); \
     PL_phase = new_phase;
 #endif
 
@@ -5153,12 +5300,14 @@ EXTCONST char *const PL_phase_names[];
 /* Do not use this macro. It only exists for extensions that rely on PL_dirty
  * instead of using the newer PL_phase, which provides everything PL_dirty
  * provided, and more. */
-#  define PL_dirty (PL_phase == PERL_PHASE_DESTRUCT)
+#  define PL_dirty cBOOL(PL_phase == PERL_PHASE_DESTRUCT)
 
 #  define PL_amagic_generation PL_na
+#  define PL_encoding ((SV *)NULL)
 #endif /* !PERL_CORE */
 
 #define PL_hints PL_compiling.cop_hints
+#define PL_maxo  MAXO
 
 END_EXTERN_C
 
@@ -5194,6 +5343,8 @@ typedef enum {
     /* update exp_name[] in toke.c if adding to this enum */
 } expectation;
 
+#define KEY_sigvar 0xFFFF /* fake keyword representing a signature var */
+
 /* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer
    special and there is no need for HINT_PRIVATE_MASK for COPs
    However, bitops store HINT_INTEGER in their op_private.
@@ -5581,120 +5732,17 @@ EXTCONST bool PL_valid_types_NV_set[];
 
 /* In C99 we could use designated (named field) union initializers.
  * In C89 we need to initialize the member declared first.
+ * In C++ we need extern C initializers.
  *
  * With the U8_NV version you will want to have inner braces,
- * while with the NV_U8 use just the NV.*/
-#define INFNAN_U8_NV_DECL EXTCONST union { U8 u8[NVSIZE]; NV nv; }
-#define INFNAN_NV_U8_DECL EXTCONST union { NV nv; U8 u8[NVSIZE]; }
-
-#ifdef DOINIT
-
-/* PL_inf and PL_nan initialization.
- *
- * For inf and nan initialization the ultimate fallback is dividing
- * one or zero by zero: however, some compilers will warn or even fail
- * on divide-by-zero, but hopefully something earlier will work.
- *
- * If you are thinking of using HUGE_VAL for infinity, or using
- * <math.h> functions to generate NV_INF (e.g. exp(1e9), log(-1.0)),
- * stop.  Neither will work portably: HUGE_VAL can be just DBL_MAX,
- * and the math functions might be just generating DBL_MAX, or even zero.
- *
- * 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?)
- */
-
-/* The quadmath literals are anon structs which -Wc++-compat doesn't like. */
-GCC_DIAG_IGNORE(-Wc++-compat)
-
-#  ifdef USE_QUADMATH
-/* Cannot use HUGE_VALQ for PL_inf because not a compile-time
- * constant. */
-INFNAN_NV_U8_DECL PL_inf = { 1.0Q/0.0Q };
-#  elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES)
-INFNAN_U8_NV_DECL PL_inf = { { LONGDBLINFBYTES } };
-#  elif NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES)
-INFNAN_U8_NV_DECL PL_inf = { { DOUBLEINFBYTES } };
-#  else
-#    if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
-#      if defined(LDBL_INFINITY)
-INFNAN_NV_U8_DECL PL_inf = { LDBL_INFINITY };
-#      elif defined(LDBL_INF)
-INFNAN_NV_U8_DECL PL_inf = { LDBL_INF };
-#      elif defined(INFINITY)
-INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
-#      elif defined(INF)
-INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
-#      else
-INFNAN_NV_U8_DECL PL_inf = { 1.0L/0.0L }; /* keep last */
-#      endif
-#    else
-#      if defined(DBL_INFINITY)
-INFNAN_NV_U8_DECL PL_inf = { DBL_INFINITY };
-#      elif defined(DBL_INF)
-INFNAN_NV_U8_DECL PL_inf = { DBL_INF };
-#      elif defined(INFINITY) /* C99 */
-INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
-#      elif defined(INF)
-INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
-#      else
-INFNAN_NV_U8_DECL PL_inf = { 1.0/0.0 }; /* keep last */
-#      endif
-#    endif
-#  endif
-
-#  ifdef USE_QUADMATH
-/* Cannot use nanq("0") for PL_nan because not a compile-time
- * constant. */
-INFNAN_NV_U8_DECL PL_nan = { 0.0Q/0.0Q };
-#  elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES)
-INFNAN_U8_NV_DECL PL_nan = { { LONGDBLNANBYTES } };
-#  elif NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES)
-INFNAN_U8_NV_DECL PL_nan = { { DOUBLENANBYTES } };
-#  else
-#    if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
-#      if defined(LDBL_NAN)
-INFNAN_NV_U8_DECL PL_nan = { LDBL_NAN };
-#      elif defined(LDBL_QNAN)
-INFNAN_NV_U8_DECL PL_nan = { LDBL_QNAN };
-#      elif defined(NAN)
-INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
-#      else
-INFNAN_NV_U8_DECL PL_nan = { 0.0L/0.0L }; /* keep last */
-#      endif
-#    else
-#      if defined(DBL_NAN)
-INFNAN_NV_U8_DECL PL_nan = { DBL_NAN };
-#      elif defined(DBL_QNAN)
-INFNAN_NV_U8_DECL PL_nan = { DBL_QNAN };
-#      elif defined(NAN) /* C99 */
-INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
-#      else
-INFNAN_NV_U8_DECL PL_nan = { 0.0/0.0 }; /* keep last */
-#      endif
-#    endif
-#  endif
-
-GCC_DIAG_RESTORE
+ * while with the NV_U8 use just the NV. */
 
+#ifdef __cplusplus
+#define INFNAN_U8_NV_DECL EXTERN_C const union { U8 u8[NVSIZE]; NV nv; }
+#define INFNAN_NV_U8_DECL EXTERN_C const union { NV nv; U8 u8[NVSIZE]; }
 #else
-
-INFNAN_NV_U8_DECL PL_inf;
-INFNAN_NV_U8_DECL PL_nan;
-
-#endif
-
-/* If you have not defined NV_INF/NV_NAN (like for example win32/win32.h),
- * we will define NV_INF/NV_NAN as the nv part of the global const
- * PL_inf/PL_nan.  Note, however, that the preexisting NV_INF/NV_NAN
- * might not be a compile-time constant, in which case it cannot be
- * used to initialize PL_inf/PL_nan above. */
-#ifndef NV_INF
-#  define NV_INF PL_inf.nv
-#endif
-#ifndef NV_NAN
-#  define NV_NAN PL_nan.nv
+#define INFNAN_U8_NV_DECL EXTCONST union { U8 u8[NVSIZE]; NV nv; }
+#define INFNAN_NV_U8_DECL EXTCONST union { NV nv; U8 u8[NVSIZE]; }
 #endif
 
 /* if these never got defined, they need defaults */
@@ -5832,9 +5880,33 @@ typedef struct am_table_short AMTS;
 
 #ifdef USE_LOCALE
 /* These locale things are all subject to change */
+
+#   define LOCALE_INIT   MUTEX_INIT(&PL_locale_mutex)
+
+#   ifdef USE_THREAD_SAFE_LOCALE
+#       define LOCALE_TERM                                                  \
+                    STMT_START {                                            \
+                        MUTEX_DESTROY(&PL_locale_mutex);                    \
+                        if (PL_C_locale_obj) {                              \
+                            /* Make sure we aren't using the locale         \
+                             * space we are about to free */                \
+                            uselocale(LC_GLOBAL_LOCALE);                    \
+                            freelocale(PL_C_locale_obj);                    \
+                            PL_C_locale_obj = (locale_t) NULL;              \
+                        }                                                   \
+                     } STMT_END
+    }
+#   else
+#       define LOCALE_TERM   MUTEX_DESTROY(&PL_locale_mutex)
+#   endif
+
+#   define LOCALE_LOCK   MUTEX_LOCK(&PL_locale_mutex)
+#   define LOCALE_UNLOCK MUTEX_UNLOCK(&PL_locale_mutex)
+
 /* Returns TRUE if the plain locale pragma without a parameter is in effect
  */
-#   define IN_LOCALE_RUNTIME   cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE)
+#   define IN_LOCALE_RUNTIME   (PL_curcop \
+                                && CopHINTS_get(PL_curcop) & HINT_LOCALE)
 
 /* Returns TRUE if either form of the locale pragma is in effect */
 #   define IN_SOME_LOCALE_FORM_RUNTIME   \
@@ -5855,7 +5927,7 @@ typedef struct am_table_short AMTS;
 
 #   define IN_LC_PARTIAL_COMPILETIME   cBOOL(PL_hints & HINT_LOCALE_PARTIAL)
 #   define IN_LC_PARTIAL_RUNTIME  \
-                        cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
+               (PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
 
 #   define IN_LC_COMPILETIME(category)                                       \
        (IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME                  \
@@ -5894,8 +5966,8 @@ typedef struct am_table_short AMTS;
        STMT_START {                                                        \
             if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) {         \
                 Perl_warner(aTHX_ packWARN(WARN_LOCALE),                    \
-                                        "Wide character (U+%"UVXf") in %s", \
-                                        (UV) cp, OP_DESC(PL_op));           \
+                                       "Wide character (U+%" UVXf ") in %s",\
+                                       (UV) cp, OP_DESC(PL_op));            \
             }                                                               \
         }  STMT_END
 
@@ -5904,7 +5976,7 @@ typedef struct am_table_short AMTS;
             if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) {         \
                 UV cp = utf8_to_uvchr_buf((U8 *) s, (U8 *) send, NULL);     \
                 Perl_warner(aTHX_ packWARN(WARN_LOCALE),                    \
-                    "Wide character (U+%"UVXf") in %s",                     \
+                    "Wide character (U+%" UVXf ") in %s",                   \
                     (cp == 0)                                               \
                      ? UNICODE_REPLACEMENT                                  \
                      : (UV) cp,                                             \
@@ -5914,7 +5986,25 @@ typedef struct am_table_short AMTS;
 
 #   endif   /* PERL_CORE or PERL_IN_XSUB_RE */
 
+#if      defined(USE_ITHREADS)              \
+    &&   defined(HAS_NEWLOCALE)             \
+    &&   defined(LC_ALL_MASK)               \
+    &&   defined(HAS_FREELOCALE)            \
+    &&   defined(HAS_USELOCALE)             \
+    && ! defined(NO_THREAD_SAFE_USELOCALE)
+
+    /* The code is written for simplicity to assume that any platform advanced
+     * enough to have the Posix 2008 locale functions has LC_ALL.  The test
+     * above makes sure that assumption is valid */
+
+#   define USE_THREAD_SAFE_LOCALE
+#endif
+
 #else   /* No locale usage */
+#   define LOCALE_INIT
+#   define LOCALE_TERM
+#   define LOCALE_LOCK
+#   define LOCALE_UNLOCK
 #   define IN_LOCALE_RUNTIME                0
 #   define IN_SOME_LOCALE_FORM_RUNTIME      0
 #   define IN_LOCALE_COMPILETIME            0
@@ -6224,13 +6314,8 @@ expression, but with an empty argument list, like this:
 #define PERL_SCRIPT_MODE "r"
 #endif
 
-/*
- * Some operating systems are stingy with stack allocation,
- * so perl may have to guard against stack overflow.
- */
-#ifndef PERL_STACK_OVERFLOW_CHECK
+/* not used. Kept as a NOOP for backcompat */
 #define PERL_STACK_OVERFLOW_CHECK()  NOOP
-#endif
 
 /*
  * Some nonpreemptive operating systems find it convenient to
@@ -6604,6 +6689,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
@@ -6621,37 +6714,115 @@ extern void moncontrol(int);
 #  define DOUBLE_MIX_ENDIAN
 #endif
 
+/* The VAX fp formats are neither consistently little-endian nor
+ * big-endian, and neither are they really IEEE-mixed endian like
+ * the mixed-endian ARM IEEE formats (with swapped bytes).
+ * Ultimately, the VAX format came from the PDP-11.
+ *
+ * The ordering of the parts in VAX floats is quite vexing.
+ * In the below the fraction_n are the mantissa bits.
+ *
+ * The fraction_1 is the most significant (numbering as by DEC/Digital),
+ * while the rightmost bit in each fraction is the least significant:
+ * in other words, big-endian bit order within the fractions.
+ *
+ * The fraction segments themselves would be big-endianly, except that
+ * within 32 bit segments the less significant half comes first, the more
+ * significant after, except that in the format H (used for long doubles)
+ * the first fraction segment is alone, because the exponent is wider.
+ * This means for example that both the most and the least significant
+ * bits can be in the middle of the floats, not at either end.
+ *
+ * References:
+ * http://nssdc.gsfc.nasa.gov/nssdc/formats/VAXFloatingPoint.htm
+ * http://www.quadibloc.com/comp/cp0201.htm
+ * http://h71000.www7.hp.com/doc/82final/6443/6443pro_028.html
+ * (somebody at HP should be fired for the URLs)
+ *
+ * F   fraction_2:16 sign:1 exp:8  fraction_1:7
+ *     (exponent bias 128, hidden first one-bit)
+ *
+ * D   fraction_2:16 sign:1 exp:8  fraction_1:7
+ *     fraction_4:16               fraction_3:16
+ *     (exponent bias 128, hidden first one-bit)
+ *
+ * G   fraction_2:16 sign:1 exp:11 fraction_1:4
+ *     fraction_4:16               fraction_3:16
+ *     (exponent bias 1024, hidden first one-bit)
+ *
+ * H   fraction_1:16 sign:1 exp:15
+ *     fraction_3:16               fraction_2:16
+ *     fraction_5:16               fraction_4:16
+ *     fraction_7:16               fraction_6:16
+ *     (exponent bias 16384, hidden first one-bit)
+ *     (available only on VAX, and only on Fortran?)
+ *
+ * The formats S, T and X are available on the Alpha (and Itanium,
+ * also known as I64/IA64) and are equivalent with the IEEE-754 formats
+ * binary32, binary64, and binary128 (commonly: float, double, long double).
+ *
+ * S   sign:1 exp:8 mantissa:23
+ *     (exponent bias 127, hidden first one-bit)
+ *
+ * T   sign:1 exp:11 mantissa:52
+ *     (exponent bias 1022, hidden first one-bit)
+ *
+ * X   sign:1 exp:15 mantissa:112
+ *     (exponent bias 16382, hidden first one-bit)
+ *
+ */
+
+#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
+ * except for the x86 80-bit extended formats, which will undef this.
+ * Also note that the IEEE 754 subnormals (formerly known as denormals)
+ * do not have the implicit bit of one. */
+#  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 || \
-      LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+      LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE
 #    define LONGDOUBLE_LITTLE_ENDIAN
 #  endif
 
 #  if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN || \
       LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN || \
-      LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+      LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE
 #    define LONGDOUBLE_BIG_ENDIAN
 #  endif
 
+#  if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \
+      LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
+#    define LONGDOUBLE_MIX_ENDIAN
+#  endif
+
 #  if LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
       LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
 #    define LONGDOUBLE_X86_80_BIT
 #    ifdef USE_LONG_DOUBLE
 #      undef NV_IMPLICIT_BIT
+#      define NV_X86_80_BIT
 #    endif
 #  endif
 
-#  if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN || \
-      LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+#  if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE || \
+      LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE || \
+      LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \
+      LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
 #    define LONGDOUBLE_DOUBLEDOUBLE
 #  endif
 
+#  if LONG_DOUBLEKIND == LONG_DOUBLE_IS_VAX_H_FLOAT
+#    define LONGDOUBLE_VAX_ENDIAN
+#  endif
+
 #endif /* LONG_DOUBLEKIND */
 
 #ifdef USE_QUADMATH /* assume quadmath endianness == native double endianness */
@@ -6672,6 +6843,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
@@ -6679,6 +6853,135 @@ extern void moncontrol(int);
 #  ifdef LONGDOUBLE_BIG_ENDIAN
 #    define NV_BIG_ENDIAN
 #  endif
+#  ifdef LONGDOUBLE_MIX_ENDIAN
+#    define NV_MIX_ENDIAN
+#  endif
+#  ifdef LONGDOUBLE_VAX_ENDIAN
+#    define NV_VAX_ENDIAN
+#  endif
+#endif
+
+#ifdef DOUBLE_IS_IEEE_FORMAT
+#  define DOUBLE_HAS_INF
+#  define DOUBLE_HAS_NAN
+#endif
+
+#ifdef DOUBLE_HAS_NAN
+
+#ifdef DOINIT
+
+/* PL_inf and PL_nan initialization.
+ *
+ * For inf and nan initialization the ultimate fallback is dividing
+ * one or zero by zero: however, some compilers will warn or even fail
+ * on divide-by-zero, but hopefully something earlier will work.
+ *
+ * If you are thinking of using HUGE_VAL for infinity, or using
+ * <math.h> functions to generate NV_INF (e.g. exp(1e9), log(-1.0)),
+ * stop.  Neither will work portably: HUGE_VAL can be just DBL_MAX,
+ * and the math functions might be just generating DBL_MAX, or even zero.
+ *
+ * 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. */
+GCC_DIAG_IGNORE(-Wc++-compat)
+
+#  ifdef USE_QUADMATH
+/* Cannot use HUGE_VALQ for PL_inf because not a compile-time
+ * constant. */
+INFNAN_NV_U8_DECL PL_inf = { 1.0Q/0.0Q };
+#  elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES)
+INFNAN_U8_NV_DECL PL_inf = { { LONGDBLINFBYTES } };
+#  elif NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES)
+INFNAN_U8_NV_DECL PL_inf = { { DOUBLEINFBYTES } };
+#  else
+#    if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
+#      if defined(LDBL_INFINITY)
+INFNAN_NV_U8_DECL PL_inf = { LDBL_INFINITY };
+#      elif defined(LDBL_INF)
+INFNAN_NV_U8_DECL PL_inf = { LDBL_INF };
+#      elif defined(INFINITY)
+INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
+#      elif defined(INF)
+INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
+#      else
+INFNAN_NV_U8_DECL PL_inf = { 1.0L/0.0L }; /* keep last */
+#      endif
+#    else
+#      if defined(DBL_INFINITY)
+INFNAN_NV_U8_DECL PL_inf = { DBL_INFINITY };
+#      elif defined(DBL_INF)
+INFNAN_NV_U8_DECL PL_inf = { DBL_INF };
+#      elif defined(INFINITY) /* C99 */
+INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
+#      elif defined(INF)
+INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
+#      else
+INFNAN_NV_U8_DECL PL_inf = { 1.0/0.0 }; /* keep last */
+#      endif
+#    endif
+#  endif
+
+#  ifdef USE_QUADMATH
+/* Cannot use nanq("0") for PL_nan because not a compile-time
+ * constant. */
+INFNAN_NV_U8_DECL PL_nan = { 0.0Q/0.0Q };
+#  elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES)
+INFNAN_U8_NV_DECL PL_nan = { { LONGDBLNANBYTES } };
+#  elif NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES)
+INFNAN_U8_NV_DECL PL_nan = { { DOUBLENANBYTES } };
+#  else
+#    if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
+#      if defined(LDBL_NAN)
+INFNAN_NV_U8_DECL PL_nan = { LDBL_NAN };
+#      elif defined(LDBL_QNAN)
+INFNAN_NV_U8_DECL PL_nan = { LDBL_QNAN };
+#      elif defined(NAN)
+INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
+#      else
+INFNAN_NV_U8_DECL PL_nan = { 0.0L/0.0L }; /* keep last */
+#      endif
+#    else
+#      if defined(DBL_NAN)
+INFNAN_NV_U8_DECL PL_nan = { DBL_NAN };
+#      elif defined(DBL_QNAN)
+INFNAN_NV_U8_DECL PL_nan = { DBL_QNAN };
+#      elif defined(NAN) /* C99 */
+INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
+#      else
+INFNAN_NV_U8_DECL PL_nan = { 0.0/0.0 }; /* keep last */
+#      endif
+#    endif
+#  endif
+
+GCC_DIAG_RESTORE
+
+#else
+
+INFNAN_NV_U8_DECL PL_inf;
+INFNAN_NV_U8_DECL PL_nan;
+
+#endif
+
+/* If you have not defined NV_INF/NV_NAN (like for example win32/win32.h),
+ * we will define NV_INF/NV_NAN as the nv part of the global const
+ * PL_inf/PL_nan.  Note, however, that the preexisting NV_INF/NV_NAN
+ * might not be a compile-time constant, in which case it cannot be
+ * used to initialize PL_inf/PL_nan above. */
+#ifndef NV_INF
+#  define NV_INF PL_inf.nv
+#endif
+#ifndef NV_NAN
+#  define NV_NAN PL_nan.nv
 #endif
 
 /* NaNs (not-a-numbers) can carry payload bits, in addition to
@@ -6794,10 +7097,14 @@ extern void moncontrol(int);
 #    define NV_NAN_QS_BYTE_OFFSET 7
 #  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
 #    define NV_NAN_QS_BYTE_OFFSET 2
-#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE
 #    define NV_NAN_QS_BYTE_OFFSET 13
-#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE
 #    define NV_NAN_QS_BYTE_OFFSET 1
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE
+#    define NV_NAN_QS_BYTE_OFFSET 9
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
+#    define NV_NAN_QS_BYTE_OFFSET 6
 #  else
 #    error "Unexpected long double format"
 #  endif
@@ -6827,6 +7134,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
@@ -6839,8 +7148,10 @@ extern void moncontrol(int);
    LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN)
 #  define NV_NAN_QS_BIT_SHIFT 6 /* 0x40 */
 #elif defined(USE_LONG_DOUBLE) && \
-  (LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN || \
-   LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN)
+  (LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE || \
+   LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE || \
+   LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \
+   LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE)
 #  define NV_NAN_QS_BIT_SHIFT 3 /* 0x08, but not via NV_NAN_BITS */
 #else
 #  define NV_NAN_QS_BIT_SHIFT ((NV_NAN_BITS) % 8) /* usually 3, or 0x08 */
@@ -6881,6 +7192,10 @@ extern void moncontrol(int);
  * 0xFF means "don't go here".*/
 
 /* Shorthands to avoid typoses. */
+#define NV_NAN_PAYLOAD_MASK_SKIP_EIGHT \
+  0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0
+#define NV_NAN_PAYLOAD_PERM_SKIP_EIGHT \
+  0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff
 #define NV_NAN_PAYLOAD_PERM_0_TO_7 \
   0x0, 0x1, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7
 #define NV_NAN_PAYLOAD_PERM_7_TO_0 \
@@ -6959,17 +7274,28 @@ extern void moncontrol(int);
 #    else
 #      error "Unexpected x86 80-bit big-endian long double format"
 #    endif
-#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
-/* For double-double we assume only the first double is used for NaN. */
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE
+/* For double-double we assume only the first double (in LE or BE terms)
+ * is used for NaN. */
 #    define NV_NAN_PAYLOAD_MASK \
-       NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE
+       NV_NAN_PAYLOAD_MASK_SKIP_EIGHT, NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE
 #    define NV_NAN_PAYLOAD_PERM \
-       NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE
-#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+       NV_NAN_PAYLOAD_PERM_SKIP_EIGHT, NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE
 #    define NV_NAN_PAYLOAD_MASK \
        NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE
 #    define NV_NAN_PAYLOAD_PERM \
        NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE
+#    define NV_NAN_PAYLOAD_MASK \
+       NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE
+#    define NV_NAN_PAYLOAD_PERM \
+       NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
+#    define NV_NAN_PAYLOAD_MASK \
+       NV_NAN_PAYLOAD_MASK_SKIP_EIGHT, NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE
+#    define NV_NAN_PAYLOAD_PERM \
+       NV_NAN_PAYLOAD_PERM_SKIP_EIGHT, NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE
 #  else
 #    error "Unexpected long double format"
 #  endif
@@ -7012,6 +7338,10 @@ extern void moncontrol(int);
 #    error "Unexpected double format"
 #  endif
 #endif
+
+#endif /* DOUBLE_HAS_NAN */
+
+
 /*
 
    (KEEP THIS LAST IN perl.h!)