This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix -p function and Fcntl::S_IFIFO constant under Microsoft VC compiler
[perl5.git] / perl.h
diff --git a/perl.h b/perl.h
index e07416e..0e52ebc 100644 (file)
--- a/perl.h
+++ b/perl.h
 #   endif
 #endif
 
-/* This logic needs to come after reading config.h, but before including
-   proto.h  */
-#ifdef IAMSUID
-#  ifndef DOSUID
-#    define DOSUID
-#  endif
-#endif
-
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-#  ifdef DOSUID
-#    undef DOSUID
-#  endif
-#  ifdef IAMSUID
-#    undef IAMSUID
-#    define SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID
-#  endif
-#endif
-
 /* See L<perlguts/"The Perl API"> for detailed notes on
  * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
 
 #   endif
 #endif
 
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+#  define START_EXTERN_C extern "C" {
+#  define END_EXTERN_C }
+#  define EXTERN_C extern "C"
+#else
+#  define START_EXTERN_C
+#  define END_EXTERN_C
+#  define EXTERN_C extern
+#endif
+
 #ifdef PERL_GLOBAL_STRUCT
 #  ifndef PERL_GET_VARS
 #    ifdef PERL_GLOBAL_STRUCT_PRIVATE
-       extern struct perl_vars* Perl_GetVarsPrivate();
+       EXTERN_C struct perl_vars* Perl_GetVarsPrivate();
 #      define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */
 #      ifndef PERLIO_FUNCS_CONST
 #        define PERLIO_FUNCS_CONST /* Can't have these lying around. */
 #  endif
 #endif
 
-#undef START_EXTERN_C
-#undef END_EXTERN_C
-#undef EXTERN_C
-#ifdef __cplusplus
-#  define START_EXTERN_C extern "C" {
-#  define END_EXTERN_C }
-#  define EXTERN_C extern "C"
-#else
-#  define START_EXTERN_C
-#  define END_EXTERN_C
-#  define EXTERN_C extern
-#endif
-
 /* Some platforms require marking function declarations
  * for them to be exportable.  Used in perlio.h, proto.h
  * is handled either by the makedef.pl or by defining the
@@ -677,6 +659,11 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #   include <unistd.h>
 #endif
 
+/* for WCOREDUMP */
+#ifdef I_SYS_WAIT
+#   include <sys/wait.h>
+#endif
+
 #ifdef __SYMBIAN32__
 #   undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */
 #endif
@@ -956,7 +943,7 @@ EXTERN_C int usleep(unsigned int);
 #define PERL_USES_PL_PIDSTATUS
 #endif
 
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__)
 #define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
 #endif
 
@@ -1156,6 +1143,13 @@ EXTERN_C int usleep(unsigned int);
 #   include <sys/stat.h>
 #endif
 
+/* Microsoft VC's sys/stat.h defines all S_Ixxx macros except S_IFIFO.
+   This definition should ideally go into win32/win32.h, but S_IFIFO is
+   used later here in perl.h before win32/win32.h is being included. */
+#if !defined(S_IFIFO) && defined(_S_IFIFO)
+#   define S_IFIFO _S_IFIFO
+#endif
+
 /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
    like UTekV) are broken, sometimes giving false positives.  Undefine
    them here and let the code below set them to proper values.
@@ -1277,6 +1271,11 @@ EXTERN_C char *crypt(const char *, const char *);
            set_errno(errcode);         \
            set_vaxc_errno(vmserrcode); \
        } STMT_END
+#   define dSAVEDERRNO    int saved_errno; unsigned saved_vms_errno
+#   define dSAVE_ERRNO    int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno
+#   define SAVE_ERRNO     ( saved_errno = errno, saved_vms_errno = vaxc$errno )
+#   define RESTORE_ERRNO  SETERRNO(saved_errno, saved_vms_errno)
+
 #   define LIB_INVARG          LIB$_INVARG
 #   define RMS_DIR             RMS$_DIR
 #   define RMS_FAC             RMS$_FAC
@@ -1291,6 +1290,11 @@ EXTERN_C char *crypt(const char *, const char *);
 #   define SS_NORMAL           SS$_NORMAL
 #else
 #   define SETERRNO(errcode,vmserrcode) (errno = (errcode))
+#   define dSAVEDERRNO    int saved_errno
+#   define dSAVE_ERRNO    int saved_errno = errno
+#   define SAVE_ERRNO     (saved_errno = errno)
+#   define RESTORE_ERRNO  (errno = saved_errno)
+
 #   define LIB_INVARG          0
 #   define RMS_DIR             0
 #   define RMS_FAC             0
@@ -1306,8 +1310,12 @@ EXTERN_C char *crypt(const char *, const char *);
 #endif
 
 #define ERRSV GvSV(PL_errgv)
-/* FIXME? Change the assignments to PL_defgv to instantiate GvSV?  */
-#define DEFSV GvSVn(PL_defgv)
+#ifdef PERL_CORE
+# define DEFSV (0 + GvSVn(PL_defgv))
+#else
+# define DEFSV GvSVn(PL_defgv)
+#endif
+#define DEFSV_set(sv) (GvSV(PL_defgv) = (sv))
 #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
 
 #define ERRHV GvHV(PL_errgv)   /* XXX unused, here for compatibility */
@@ -2501,7 +2509,7 @@ typedef struct clone_params CLONE_PARAMS;
 #   endif
 #endif
 
-#if defined(OS2) || defined(MACOS_TRADITIONAL)
+#if defined(OS2)
 #  include "iperlsys.h"
 #endif
 
@@ -2563,13 +2571,6 @@ typedef struct clone_params CLONE_PARAMS;
 #   define ISHISH "symbian"
 #endif
 
-#if defined(MACOS_TRADITIONAL)
-#   include "macos/macish.h"
-#   ifndef NO_ENVIRON_ARRAY
-#       define NO_ENVIRON_ARRAY
-#   endif
-#   define ISHISH "macos classic"
-#endif
 
 #if defined(__HAIKU__)
 #   include "haiku/haikuish.h"
@@ -2679,6 +2680,25 @@ typedef struct clone_params CLONE_PARAMS;
 #  define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp)
 #endif
 
+/*
+=for apidoc Am|void|PERL_SYS_INIT|int argc|char** argv
+Provides system-specific tune up of the C runtime environment necessary to
+run Perl interpreters. This should be called only once, before creating
+any Perl interpreters.
+
+=for apidoc Am|void|PERL_SYS_INIT3|int argc|char** argv|char** env
+Provides system-specific tune up of the C runtime environment necessary to
+run Perl interpreters. This should be called only once, before creating
+any Perl interpreters.
+
+=for apidoc Am|void|PERL_SYS_TERM|
+Provides system-specific clean up of the C runtime environment after
+running Perl interpreters. This should be called only once, after
+freeing any remaining Perl interpreters.
+
+=cut
+ */
+
 #define PERL_SYS_INIT(argc, argv)      Perl_sys_init(argc, argv)
 #define PERL_SYS_INIT3(argc, argv, env)        Perl_sys_init3(argc, argv, env)
 #define PERL_SYS_TERM()                        Perl_sys_term()
@@ -2728,6 +2748,9 @@ typedef struct clone_params CLONE_PARAMS;
 
 #ifndef PERL_MICRO
 #if defined __GNUC__ && !defined(__INTEL_COMPILER)
+#  if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */
+#    define HASATTRIBUTE_DEPRECATED
+#  endif
 #  if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
 #    define HASATTRIBUTE_FORMAT
 #    if defined __MINGW32__
@@ -2911,11 +2934,11 @@ typedef pthread_key_t   perl_key;
        } STMT_END
 
   /* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets
-   * the NATIVE error status based on it.  It does not assume that
-   * the UNIX/POSIX exit codes have any relationship to errno, except
-   * that 0 indicates a success.  When in the default mode to comply
-   * with the Perl VMS documentation, any other code sets the NATIVE
-   * status to a failure code of SS$_ABORT.
+   * the NATIVE error status based on it.
+   *
+   * When in the default mode to comply with the Perl VMS documentation,
+   * 0 is a success and any other code sets the NATIVE status to a failure
+   * code of SS$_ABORT.
    *
    * In the new POSIX EXIT mode, native status will be set so that the
    * actual exit code will can be retrieved by the calling program or
@@ -2929,30 +2952,31 @@ typedef pthread_key_t   perl_key;
        STMT_START {                                    \
            I32 evalue = (I32)n;                        \
            PL_statusvalue = evalue;                    \
-           if (evalue != -1) {                         \
-             if (evalue <= 0xFF00) {                   \
-               if (evalue > 0xFF)                      \
-                 evalue = (evalue >> child_offset_bits) & 0xFF; \
-               if (evalue == 0)                        \
-                 PL_statusvalue_vms == SS$_NORMAL;     \
-               else                                    \
-                 if (MY_POSIX_EXIT)                    \
-                   PL_statusvalue_vms =        \
-                      (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
-                       (STS$K_ERROR | STS$M_INHIB_MSG) : 1); \
-                 else                                  \
-                   PL_statusvalue_vms = SS$_ABORT; \
-             } else { /* forgive them Perl, for they have sinned */ \
-               if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \
-               else PL_statusvalue_vms = vaxc$errno;           \
-               /* And obviously used a VMS status value instead of UNIX */ \
-               PL_statusvalue = EVMSERR;                               \
-             }                                                 \
-           }                                                   \
-           else PL_statusvalue_vms = SS$_ABORT;                \
-           set_vaxc_errno(PL_statusvalue_vms);                 \
+           if (MY_POSIX_EXIT) { \
+             if (evalue <= 0xFF00) {           \
+                 if (evalue > 0xFF)                    \
+                   evalue = (evalue >> child_offset_bits) & 0xFF; \
+                 PL_statusvalue_vms =          \
+                   (C_FAC_POSIX | (evalue << 3 ) |     \
+                   ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \
+             } else /* forgive them Perl, for they have sinned */ \
+               PL_statusvalue_vms = evalue; \
+           } else { \
+             if (evalue == 0)                  \
+               PL_statusvalue_vms = SS$_NORMAL;        \
+             else if (evalue <= 0xFF00) \
+               PL_statusvalue_vms = SS$_ABORT; \
+             else { /* forgive them Perl, for they have sinned */ \
+                 if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \
+                 else PL_statusvalue_vms = vaxc$errno; \
+                 /* And obviously used a VMS status value instead of UNIX */ \
+                 PL_statusvalue = EVMSERR;             \
+             } \
+             set_vaxc_errno(PL_statusvalue_vms);       \
+           }                                           \
        } STMT_END
 
+
   /* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code
    * and sets the NATIVE error status based on it.  This special case
    * is needed to maintain compatibility with past VMS behavior.
@@ -2965,6 +2989,9 @@ typedef pthread_key_t     perl_key;
    * actual exit code will can be retrieved by the calling program or
    * shell.
    *
+   * A POSIX exit code is from 0 to 255.  If the exit code is higher
+   * than this, it needs to be assumed that it is a VMS exit code and
+   * passed through.
    */
 
 #   define STATUS_EXIT_SET(n)                          \
@@ -2972,9 +2999,10 @@ typedef pthread_key_t    perl_key;
            I32 evalue = (I32)n;                        \
            PL_statusvalue = evalue;                    \
            if (MY_POSIX_EXIT)                          \
-               PL_statusvalue_vms =                    \
-                 (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
-                  (STS$K_ERROR | STS$M_INHIB_MSG) : 1); \
+               if (evalue > 255) PL_statusvalue_vms = evalue; else {   \
+                 PL_statusvalue_vms = \
+                   (C_FAC_POSIX | (evalue << 3 ) |     \
+                    ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \
            else                                        \
                PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \
            set_vaxc_errno(PL_statusvalue_vms);         \
@@ -3051,10 +3079,18 @@ typedef pthread_key_t   perl_key;
 #  define MEMBER_TO_FPTR(name)         name
 #endif
 
+#ifndef PERL_CORE
 /* format to use for version numbers in file/directory names */
 /* XXX move to Configure? */
-#ifndef PERL_FS_VER_FMT
-#  define PERL_FS_VER_FMT      "%d.%d.%d"
+/* This was only ever used for the current version, and that can be done at
+   compile time, as PERL_FS_VERSION, so should we just delete it?  */
+#  ifndef PERL_FS_VER_FMT
+#    define PERL_FS_VER_FMT    "%d.%d.%d"
+#  endif
+#endif
+
+#ifndef PERL_FS_VERSION
+#  define PERL_FS_VERSION      PERL_VERSION_STRING
 #endif
 
 /* This defines a way to flush all output buffers.  This may be a
@@ -3142,6 +3178,9 @@ typedef pthread_key_t     perl_key;
 #  endif
 #endif
 
+#ifdef HASATTRIBUTE_DEPRECATED
+#  define __attribute__deprecated__         __attribute__((deprecated))
+#endif
 #ifdef HASATTRIBUTE_FORMAT
 #  define __attribute__format__(x,y,z)      __attribute__((format(x,y,z)))
 #endif
@@ -3165,6 +3204,9 @@ typedef pthread_key_t     perl_key;
 #endif
 
 /* If we haven't defined the attributes yet, define them to blank. */
+#ifndef __attribute__deprecated__
+#  define __attribute__deprecated__
+#endif
 #ifndef __attribute__format__
 #  define __attribute__format__(x,y,z)
 #endif
@@ -3298,7 +3340,7 @@ typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
 #endif /* threading */
 #endif /* AIX */
 
-#if !defined(OS2) && !defined(MACOS_TRADITIONAL)
+#if !defined(OS2)
 #  include "iperlsys.h"
 #endif
 
@@ -4627,6 +4669,8 @@ enum {            /* pass one of these to get_vtbl */
 #define HINT_FILETEST_ACCESS   0x00400000 /* filetest pragma */
 #define HINT_UTF8              0x00800000 /* utf8 pragma */
 
+#define HINT_NO_AMAGIC         0x01000000 /* overloading pragma */
+
 /* The following are stored in $^H{sort}, not in PL_hints */
 #define HINT_SORT_SORT_BITS    0x000000FF /* allow 256 different ones */
 #define HINT_SORT_QUICKSORT    0x00000001
@@ -4704,6 +4748,10 @@ typedef struct exitlistentry {
 #include "patchlevel.h"
 #undef PERL_PATCHLEVEL_H_IMPLICIT
 
+#define PERL_VERSION_STRING    STRINGIFY(PERL_REVISION) "." \
+                               STRINGIFY(PERL_VERSION) "." \
+                               STRINGIFY(PERL_SUBVERSION)
+
 #ifdef PERL_GLOBAL_STRUCT
 struct perl_vars {
 #  include "perlvars.h"
@@ -5325,7 +5373,7 @@ typedef struct am_table_short AMTS;
                                 PERLDBf_SUBLINE| PERLDBf_SINGLE|       \
                                 PERLDBf_NAMEEVAL| PERLDBf_NAMEANON |   \
                                 PERLDBf_SAVESRC)
-                                       /* No _NONAME, _GOTO, _ASSERTION */
+                                       /* No _NONAME, _GOTO */
 #define PERLDBf_SUB            0x01    /* Debug sub enter/exit */
 #define PERLDBf_LINE           0x02    /* Keep line # */
 #define PERLDBf_NOOPT          0x04    /* Switch off optimizations */
@@ -5338,6 +5386,8 @@ typedef struct am_table_short AMTS;
 #define PERLDBf_NAMEEVAL       0x100   /* Informative names for evals */
 #define PERLDBf_NAMEANON       0x200   /* Informative names for anon subs */
 #define PERLDBf_SAVESRC        0x400   /* Save source lines into @{"_<$filename"} */
+#define PERLDBf_SAVESRC_NOSUBS 0x800   /* Including evals that generate no subrouties */
+#define PERLDBf_SAVESRC_INVALID        0x1000  /* Save source that did not compile */
 
 #define PERLDB_SUB     (PL_perldb && (PL_perldb & PERLDBf_SUB))
 #define PERLDB_LINE    (PL_perldb && (PL_perldb & PERLDBf_LINE))
@@ -5349,8 +5399,9 @@ typedef struct am_table_short AMTS;
 #define PERLDB_GOTO    (PL_perldb && (PL_perldb & PERLDBf_GOTO))
 #define PERLDB_NAMEEVAL        (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL))
 #define PERLDB_NAMEANON        (PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
-#define PERLDB_ASSERTION (PL_perldb && (PL_perldb & PERLDBf_ASSERTION))
 #define PERLDB_SAVESRC         (PL_perldb && (PL_perldb & PERLDBf_SAVESRC))
+#define PERLDB_SAVESRC_NOSUBS  (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS))
+#define PERLDB_SAVESRC_INVALID (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID))
 
 #ifdef USE_LOCALE_NUMERIC
 
@@ -5711,64 +5762,6 @@ int flock(int fd, int op);
 #   endif
 #endif
 
-#ifdef IAMSUID
-
-#ifdef I_SYS_STATVFS
-#   if defined(PERL_SCO) && !defined(_SVID3)
-#       define _SVID3
-#   endif
-#   include <sys/statvfs.h>     /* for f?statvfs() */
-#endif
-#ifdef I_SYS_MOUNT
-#   include <sys/mount.h>       /* for *BSD f?statfs() */
-#endif
-#ifdef I_MNTENT
-#   include <mntent.h>          /* for getmntent() */
-#endif
-#ifdef I_SYS_STATFS
-#   include <sys/statfs.h>      /* for some statfs() */
-#endif
-#ifdef I_SYS_VFS
-#  ifdef __sgi
-#    define sv IRIX_sv         /* kludge: IRIX has an sv of its own */
-#  endif
-#    include <sys/vfs.h>       /* for some statfs() */
-#  ifdef __sgi
-#    undef IRIX_sv
-#  endif
-#endif
-#ifdef I_USTAT
-#   include <ustat.h>           /* for ustat() */
-#endif
-
-#if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID)
-#    define PERL_MOUNT_NOSUID MOUNT_NOSUID
-#endif
-#if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
-#    define PERL_MOUNT_NOSUID MNT_NOSUID
-#endif
-#if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
-#   define PERL_MOUNT_NOSUID MS_NOSUID
-#endif
-#if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
-#   define PERL_MOUNT_NOSUID M_NOSUID
-#endif
-
-#if !defined(PERL_MOUNT_NOEXEC) && defined(MOUNT_NOEXEC)
-#    define PERL_MOUNT_NOEXEC MOUNT_NOEXEC
-#endif
-#if !defined(PERL_MOUNT_NOEXEC) && defined(MNT_NOEXEC)
-#    define PERL_MOUNT_NOEXEC MNT_NOEXEC
-#endif
-#if !defined(PERL_MOUNT_NOEXEC) && defined(MS_NOEXEC)
-#   define PERL_MOUNT_NOEXEC MS_NOEXEC
-#endif
-#if !defined(PERL_MOUNT_NOEXEC) && defined(M_NOEXEC)
-#   define PERL_MOUNT_NOEXEC M_NOEXEC
-#endif
-
-#endif /* IAMSUID */
-
 #ifdef I_LIBUTIL
 #   include <libutil.h>                /* setproctitle() in some FreeBSDs */
 #endif