This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #39739] Exporter::Heavy ignores custom $SIG{__WARN__} handlers
[perl5.git] / perl.h
diff --git a/perl.h b/perl.h
index 17e6299..cfcf871 100644 (file)
--- a/perl.h
+++ b/perl.h
 #define USE_STDIO
 #endif /* PERL_FOR_X2P */
 
-#if defined(DGUX)
-#include <sys/fcntl.h>
-#endif
-
 #ifdef VOIDUSED
 #   undef VOIDUSED
 #endif
 #define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \
     RX_ENGINE(prog)->exec(aTHX_ (prog),(stringarg),(strend), \
         (strbeg),(minend),(screamer),(data),(flags))
-#define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \
-    RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strpos), \
+#define CALLREG_INTUIT_START(prog,sv,strbeg,strpos,strend,flags,data) \
+    RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strbeg), (strpos), \
         (strend),(flags),(data))
 #define CALLREG_INTUIT_STRING(prog) \
     RX_ENGINE(prog)->checkstr(aTHX_ (prog))
@@ -520,7 +516,7 @@ struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 # define STANDARD_C 1
 #endif
 
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
 # define DONT_DECLARE_STD 1
 #endif
 
@@ -695,6 +691,8 @@ struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 
 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
 #   define USE_LOCALE
+#   define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
+                                   capability */
 #   if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
        && defined(HAS_STRXFRM)
 #      define USE_LOCALE_COLLATE
@@ -705,6 +703,12 @@ struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #   if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC)
 #      define USE_LOCALE_NUMERIC
 #   endif
+#   if !defined(NO_LOCALE_MESSAGES) && defined(LC_MESSAGES)
+#      define USE_LOCALE_MESSAGES
+#   endif
+#   if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY)
+#      define USE_LOCALE_MONETARY
+#   endif
 #endif /* !NO_LOCALE && HAS_SETLOCALE */
 
 #include <setjmp.h>
@@ -795,189 +799,6 @@ EXTERN_C int usleep(unsigned int);
           (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) ))
 # endif
 
-/*----------------------------------------------------------------------------*/
-# if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678  /*     little-endian     */
-/*----------------------------------------------------------------------------*/
-#  define my_htole16(x)                (x)
-#  define my_letoh16(x)                (x)
-#  define my_htole32(x)                (x)
-#  define my_letoh32(x)                (x)
-#  define my_htobe16(x)                _swab_16_(x)
-#  define my_betoh16(x)                _swab_16_(x)
-#  define my_htobe32(x)                _swab_32_(x)
-#  define my_betoh32(x)                _swab_32_(x)
-#  ifdef HAS_QUAD
-#   define my_htole64(x)       (x)
-#   define my_letoh64(x)       (x)
-#   define my_htobe64(x)       _swab_64_(x)
-#   define my_betoh64(x)       _swab_64_(x)
-#  endif
-#  define my_htoles(x)         (x)
-#  define my_letohs(x)         (x)
-#  define my_htolei(x)         (x)
-#  define my_letohi(x)         (x)
-#  define my_htolel(x)         (x)
-#  define my_letohl(x)         (x)
-#  if SHORTSIZE == 1
-#   define my_htobes(x)                (x)
-#   define my_betohs(x)                (x)
-#  elif SHORTSIZE == 2
-#   define my_htobes(x)                _swab_16_(x)
-#   define my_betohs(x)                _swab_16_(x)
-#  elif SHORTSIZE == 4
-#   define my_htobes(x)                _swab_32_(x)
-#   define my_betohs(x)                _swab_32_(x)
-#  elif SHORTSIZE == 8
-#   define my_htobes(x)                _swab_64_(x)
-#   define my_betohs(x)                _swab_64_(x)
-#  else
-#   define PERL_NEED_MY_HTOBES
-#   define PERL_NEED_MY_BETOHS
-#  endif
-#  if INTSIZE == 1
-#   define my_htobei(x)                (x)
-#   define my_betohi(x)                (x)
-#  elif INTSIZE == 2
-#   define my_htobei(x)                _swab_16_(x)
-#   define my_betohi(x)                _swab_16_(x)
-#  elif INTSIZE == 4
-#   define my_htobei(x)                _swab_32_(x)
-#   define my_betohi(x)                _swab_32_(x)
-#  elif INTSIZE == 8
-#   define my_htobei(x)                _swab_64_(x)
-#   define my_betohi(x)                _swab_64_(x)
-#  else
-#   define PERL_NEED_MY_HTOBEI
-#   define PERL_NEED_MY_BETOHI
-#  endif
-#  if LONGSIZE == 1
-#   define my_htobel(x)                (x)
-#   define my_betohl(x)                (x)
-#  elif LONGSIZE == 2
-#   define my_htobel(x)                _swab_16_(x)
-#   define my_betohl(x)                _swab_16_(x)
-#  elif LONGSIZE == 4
-#   define my_htobel(x)                _swab_32_(x)
-#   define my_betohl(x)                _swab_32_(x)
-#  elif LONGSIZE == 8
-#   define my_htobel(x)                _swab_64_(x)
-#   define my_betohl(x)                _swab_64_(x)
-#  else
-#   define PERL_NEED_MY_HTOBEL
-#   define PERL_NEED_MY_BETOHL
-#  endif
-#  define my_htolen(p,n)       NOOP
-#  define my_letohn(p,n)       NOOP
-#  define my_htoben(p,n)       my_swabn(p,n)
-#  define my_betohn(p,n)       my_swabn(p,n)
-/*----------------------------------------------------------------------------*/
-# elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321  /*     big-endian      */
-/*----------------------------------------------------------------------------*/
-#  define my_htobe16(x)                (x)
-#  define my_betoh16(x)                (x)
-#  define my_htobe32(x)                (x)
-#  define my_betoh32(x)                (x)
-#  define my_htole16(x)                _swab_16_(x)
-#  define my_letoh16(x)                _swab_16_(x)
-#  define my_htole32(x)                _swab_32_(x)
-#  define my_letoh32(x)                _swab_32_(x)
-#  ifdef HAS_QUAD
-#   define my_htobe64(x)       (x)
-#   define my_betoh64(x)       (x)
-#   define my_htole64(x)       _swab_64_(x)
-#   define my_letoh64(x)       _swab_64_(x)
-#  endif
-#  define my_htobes(x)         (x)
-#  define my_betohs(x)         (x)
-#  define my_htobei(x)         (x)
-#  define my_betohi(x)         (x)
-#  define my_htobel(x)         (x)
-#  define my_betohl(x)         (x)
-#  if SHORTSIZE == 1
-#   define my_htoles(x)                (x)
-#   define my_letohs(x)                (x)
-#  elif SHORTSIZE == 2
-#   define my_htoles(x)                _swab_16_(x)
-#   define my_letohs(x)                _swab_16_(x)
-#  elif SHORTSIZE == 4
-#   define my_htoles(x)                _swab_32_(x)
-#   define my_letohs(x)                _swab_32_(x)
-#  elif SHORTSIZE == 8
-#   define my_htoles(x)                _swab_64_(x)
-#   define my_letohs(x)                _swab_64_(x)
-#  else
-#   define PERL_NEED_MY_HTOLES
-#   define PERL_NEED_MY_LETOHS
-#  endif
-#  if INTSIZE == 1
-#   define my_htolei(x)                (x)
-#   define my_letohi(x)                (x)
-#  elif INTSIZE == 2
-#   define my_htolei(x)                _swab_16_(x)
-#   define my_letohi(x)                _swab_16_(x)
-#  elif INTSIZE == 4
-#   define my_htolei(x)                _swab_32_(x)
-#   define my_letohi(x)                _swab_32_(x)
-#  elif INTSIZE == 8
-#   define my_htolei(x)                _swab_64_(x)
-#   define my_letohi(x)                _swab_64_(x)
-#  else
-#   define PERL_NEED_MY_HTOLEI
-#   define PERL_NEED_MY_LETOHI
-#  endif
-#  if LONGSIZE == 1
-#   define my_htolel(x)                (x)
-#   define my_letohl(x)                (x)
-#  elif LONGSIZE == 2
-#   define my_htolel(x)                _swab_16_(x)
-#   define my_letohl(x)                _swab_16_(x)
-#  elif LONGSIZE == 4
-#   define my_htolel(x)                _swab_32_(x)
-#   define my_letohl(x)                _swab_32_(x)
-#  elif LONGSIZE == 8
-#   define my_htolel(x)                _swab_64_(x)
-#   define my_letohl(x)                _swab_64_(x)
-#  else
-#   define PERL_NEED_MY_HTOLEL
-#   define PERL_NEED_MY_LETOHL
-#  endif
-#  define my_htolen(p,n)       my_swabn(p,n)
-#  define my_letohn(p,n)       my_swabn(p,n)
-#  define my_htoben(p,n)       NOOP
-#  define my_betohn(p,n)       NOOP
-/*----------------------------------------------------------------------------*/
-# else /*                       all other byte-orders                         */
-/*----------------------------------------------------------------------------*/
-#  define PERL_NEED_MY_HTOLE16
-#  define PERL_NEED_MY_LETOH16
-#  define PERL_NEED_MY_HTOBE16
-#  define PERL_NEED_MY_BETOH16
-#  define PERL_NEED_MY_HTOLE32
-#  define PERL_NEED_MY_LETOH32
-#  define PERL_NEED_MY_HTOBE32
-#  define PERL_NEED_MY_BETOH32
-#  ifdef HAS_QUAD
-#   define PERL_NEED_MY_HTOLE64
-#   define PERL_NEED_MY_LETOH64
-#   define PERL_NEED_MY_HTOBE64
-#   define PERL_NEED_MY_BETOH64
-#  endif
-#  define PERL_NEED_MY_HTOLES
-#  define PERL_NEED_MY_LETOHS
-#  define PERL_NEED_MY_HTOBES
-#  define PERL_NEED_MY_BETOHS
-#  define PERL_NEED_MY_HTOLEI
-#  define PERL_NEED_MY_LETOHI
-#  define PERL_NEED_MY_HTOBEI
-#  define PERL_NEED_MY_BETOHI
-#  define PERL_NEED_MY_HTOLEL
-#  define PERL_NEED_MY_LETOHL
-#  define PERL_NEED_MY_HTOBEL
-#  define PERL_NEED_MY_BETOHL
-/*----------------------------------------------------------------------------*/
-# endif /*                     end of byte-order macros                       */
-/*----------------------------------------------------------------------------*/
-
 /* The old value was hard coded at 1008. (4096-16) seems to be a bit faster,
    at least on FreeBSD.  YMMV, so experiment.  */
 #ifndef PERL_ARENA_SIZE
@@ -1414,16 +1235,16 @@ EXTERN_C char *crypt(const char *, const char *);
 #endif
 
 #ifdef HAS_STRERROR
-#ifndef DONT_DECLARE_STD
+#   ifndef DONT_DECLARE_STD
 #       ifdef VMS
        char *strerror (int,...);
 #       else
        char *strerror (int);
 #       endif
-#endif
-#       ifndef Strerror
-#           define Strerror strerror
-#       endif
+#    endif
+#    ifndef Strerror
+#       define Strerror strerror
+#    endif
 #else
 #    ifdef HAS_SYS_ERRLIST
        extern int sys_nerr;
@@ -2465,6 +2286,7 @@ typedef struct xpvuv XPVUV;
 typedef struct xpvnv XPVNV;
 typedef struct xpvmg XPVMG;
 typedef struct xpvlv XPVLV;
+typedef struct xpvinvlist XINVLIST;
 typedef struct xpvav XPVAV;
 typedef struct xpvhv XPVHV;
 typedef struct xpvgv XPVGV;
@@ -2485,11 +2307,10 @@ typedef AV PAD;
 typedef AV PADNAMELIST;
 typedef SV PADNAME;
 
-/* XXX for 5.18, disable the COW by default
- * #if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW)
- * # define PERL_NEW_COPY_ON_WRITE
- * #endif
- */
+/* enable PERL_NEW_COPY_ON_WRITE by default */
+#if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW)
+#  define PERL_NEW_COPY_ON_WRITE
+#endif
 
 #if defined(PERL_OLD_COPY_ON_WRITE) || defined(PERL_NEW_COPY_ON_WRITE)
 # if defined(PERL_OLD_COPY_ON_WRITE) && defined(PERL_NEW_COPY_ON_WRITE)
@@ -2853,9 +2674,6 @@ freeing any remaining Perl interpreters.
 #  ifdef NETWARE
 #   include <nw5thread.h>
 #  else
-#  ifdef FAKE_THREADS
-#    include "fakethr.h"
-#  else
 #    ifdef WIN32
 #      include <win32thread.h>
 #    else
@@ -2882,8 +2700,7 @@ typedef pthread_key_t     perl_key;
 #        endif /* I_MACH_CTHREADS */
 #      endif /* OS2 */
 #    endif /* WIN32 */
-#  endif /* FAKE_THREADS */
-#endif /* NETWARE */
+#  endif /* NETWARE */
 #endif /* USE_ITHREADS */
 
 #if defined(WIN32)
@@ -3230,6 +3047,12 @@ typedef pthread_key_t    perl_key;
 
 #define HEKfARG(p) ((void*)(p))
 
+/* Takes three arguments: is_utf8, length, str */
+#ifndef UTF8f
+#  define UTF8f "d%"UVuf"%4p"
+#endif
+#define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p)
+
 #ifdef PERL_CORE
 /* not used; but needed for backward compatibility with XS code? - RMB */
 #  undef VDf
@@ -3591,8 +3414,7 @@ my_swap16(const U16 x) {
 #  define vtohs(x)      ((x)&0xFFFF)
 #  define htovl(x)      vtohl(x)
 #  define htovs(x)      vtohs(x)
-#else
-# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
+#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
 #  define vtohl(x)     ((((x)&0xFF)<<24)       \
                        +(((x)>>24)&0xFF)       \
                        +(((x)&0x0000FF00)<<8)  \
@@ -3600,14 +3422,11 @@ my_swap16(const U16 x) {
 #  define vtohs(x)     ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
 #  define htovl(x)     vtohl(x)
 #  define htovs(x)     vtohs(x)
-# endif
-       /* otherwise default to functions in util.c */
-#ifndef htovs
-short htovs(short n);
-short vtohs(short n);
-long htovl(long n);
-long vtohl(long n);
-#endif
+#else
+#  error "Unsupported byteorder"
+/* If you have need for current perl on PDP-11 or similar, and can help test
+   that blead keeps working on a mixed-endian system, then see
+   pod/perlhack.pod for how to submit patches to things working again.  */
 #endif
 
 /* *MAX Plus 1. A floating point value.
@@ -4255,8 +4074,7 @@ EXT char *** environ_pointer;
 #  ifdef USE_ENVIRON_ARRAY
 #    if !defined(DONT_DECLARE_STD) || \
         (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
-        defined(__sgi) || \
-        defined(__DGUX)
+        defined(__sgi)
 extern char ** environ;        /* environment variables supplied via exec */
 #    endif
 #  endif
@@ -4700,9 +4518,6 @@ EXTCONST char PL_bincompat_options[] =
 #  ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
                             " DEBUG_LEAKING_SCALARS_FORK_DUMP"
 #  endif
-#  ifdef FAKE_THREADS
-                            " FAKE_THREADS"
-#  endif
 #  ifdef FCRYPT
                             " FCRYPT"
 #  endif
@@ -4748,9 +4563,6 @@ EXTCONST char PL_bincompat_options[] =
 #  ifdef PERL_OLD_COPY_ON_WRITE
                             " PERL_OLD_COPY_ON_WRITE"
 #  endif
-#  ifdef PERL_NEW_COPY_ON_WRITE
-                            " PERL_NEW_COPY_ON_WRITE"
-#  endif
 #  ifdef PERL_POISON
                             " PERL_POISON"
 #  endif
@@ -5240,19 +5052,19 @@ EXTCONST U8 PL_magic_data[256];
 #endif
 
 #ifdef DOINIT
-                       /* NL BD IV NV PV PI PN MG RX GV LV AV HV CV FM IO */
+                       /* NL IV NV PV INV PI PN MG RX GV LV AV HV CV FM IO */
 EXTCONST bool
-PL_valid_types_IVX[]    = { 0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
+PL_valid_types_IVX[]    = { 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
 EXTCONST bool
-PL_valid_types_NVX[]    = { 0, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
+PL_valid_types_NVX[]    = { 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
 EXTCONST bool
-PL_valid_types_PVX[]    = { 0, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1, 1 };
+PL_valid_types_PVX[]    = { 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1, 1 };
 EXTCONST bool
-PL_valid_types_RV[]     = { 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1 };
+PL_valid_types_RV[]     = { 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1 };
 EXTCONST bool
-PL_valid_types_IV_set[] = { 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1 };
+PL_valid_types_IV_set[] = { 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1 };
 EXTCONST bool
-PL_valid_types_NV_set[] = { 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 };
+PL_valid_types_NV_set[] = { 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 };
 
 #else