Fix by Rick Delaney for [perl #3269] no warnings "bareword" turns off
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index bb8f217..efdf7ed 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -804,6 +804,12 @@ int usleep(unsigned int);
 
 #endif /* PERL_CORE */
 
+/* We no longer default to creating a new SV for GvSV.
+   Do this before embed.  */
+#ifndef PERL_CREATE_GVSV
+#define PERL_DONT_CREATE_GVSV
+#endif
+
 /* Cannot include embed.h here on Win32 as win32.h has not 
    yet been included and defines some config variables e.g. HAVE_INTERP_INTERN
  */
@@ -1491,20 +1497,25 @@ typedef UVTYPE UV;
 #else
 #  if PTRSIZE == LONGSIZE
 #    define PTRV               unsigned long
+#    define PTR2ul(p)          (unsigned long)(p)
 #  else
 #    define PTRV               unsigned
 #  endif
+#endif
+
+#ifndef INT2PTR
 #  define INT2PTR(any,d)       (any)(PTRV)(d)
 #endif
+
+#ifndef PTR2ul
+#  define PTR2ul(p)    INT2PTR(unsigned long,p)        
+#endif
+
 #define NUM2PTR(any,d) (any)(PTRV)(d)
 #define PTR2IV(p)      INT2PTR(IV,p)
 #define PTR2UV(p)      INT2PTR(UV,p)
 #define PTR2NV(p)      NUM2PTR(NV,p)
-#if PTRSIZE == LONGSIZE
-#  define PTR2ul(p)    (unsigned long)(p)
-#else
-#  define PTR2ul(p)    INT2PTR(unsigned long,p)        
-#endif
+#define PTR2nat(p)     (PTRV)(p)       /* pointer to integer of PTRSIZE */
 
 /* According to strict ANSI C89 one cannot freely cast between
  * data pointers and function (code) pointers.  There are at least
@@ -1516,8 +1527,8 @@ typedef UVTYPE UV;
  * The only feasible use is probably temporarily storing
  * function pointers in a data pointer (such as a void pointer). */
 
-#define DPTR2FPTR(t,p) ((t)(PTRV)(p)) /* data pointer to function pointer */
-#define FPTR2DPTR(t,p) ((t)(PTRV)(p)) /* function pointer to data pointer */
+#define DPTR2FPTR(t,p) ((t)PTR2nat(p)) /* data pointer to function pointer */
+#define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */
 
 #ifdef USE_LONG_DOUBLE
 #  if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
@@ -2325,6 +2336,64 @@ typedef struct clone_params CLONE_PARAMS;
 #   define ISHISH "unix"
 #endif
 
+/* NSIG logic from Configure --> */
+/* Strange style to avoid deeply-nested #if/#else/#endif */
+#ifndef NSIG
+#  ifdef _NSIG
+#    define NSIG (_NSIG)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef SIGMAX
+#    define NSIG (SIGMAX+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef SIG_MAX
+#    define NSIG (SIG_MAX+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef _SIG_MAX
+#    define NSIG (_SIG_MAX+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef MAXSIG
+#    define NSIG (MAXSIG+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef MAX_SIG
+#    define NSIG (MAX_SIG+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef SIGARRAYSIZE
+#    define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef _sys_nsig
+#    define NSIG (_sys_nsig) /* Solaris 2.5 */
+#  endif
+#endif
+
+/* Default to some arbitrary number that's big enough to get most
+   of the common signals.
+*/
+#ifndef NSIG
+#    define NSIG 50
+#endif
+/* <-- NSIG logic from Configure */
+
 #ifndef NO_ENVIRON_ARRAY
 #  define USE_ENVIRON_ARRAY
 #endif
@@ -2340,7 +2409,7 @@ typedef struct clone_params CLONE_PARAMS;
 #    define PERL_FPU_INIT fpsetmask(0);
 #  else
 #    if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
-#      define PERL_FPU_INIT       PL_sigfpe_saved = signal(SIGFPE, SIG_IGN);
+#      define PERL_FPU_INIT       PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN);
 #      define PERL_FPU_PRE_EXEC   { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
 #      define PERL_FPU_POST_EXEC    rsignal_restore(SIGFPE, &xfpe); }
 #    else
@@ -2478,17 +2547,25 @@ typedef pthread_key_t   perl_key;
 #   define STATUS_NATIVE       PL_statusvalue_vms
 #   define STATUS_NATIVE_EXPORT \
        (((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) | (VMSISH_HUSHED ? 0x10000000 : 0))
-#   define STATUS_NATIVE_SET(n)                                                \
+#   define STATUS_NATIVE_SET(n) STATUS_NATIVE_SET_PORC(n, 0)
+#   define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET_PORC(n, 1)
+#   define STATUS_NATIVE_SET_PORC(n, _x)                               \
        STMT_START {                                                    \
-           PL_statusvalue_vms = (n);                                   \
-           if ((I32)PL_statusvalue_vms == -1)                          \
+           I32 evalue = (I32)n;                                        \
+           if (evalue == EVMSERR) {                                    \
+             PL_statusvalue_vms = vaxc$errno;                          \
+             PL_statusvalue = evalue;                                  \
+           }                                                           \
+           else {                                                      \
+             PL_statusvalue_vms = evalue;                              \
+             if ((I32)PL_statusvalue_vms == -1)                        \
                PL_statusvalue = -1;                                    \
-           else if (PL_statusvalue_vms & STS$M_SUCCESS)                \
-               PL_statusvalue = 0;                                     \
-           else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0)        \
-               PL_statusvalue = 1 << 8;                                \
-           else                                                        \
-               PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8;    \
+             else                                                      \
+               PL_statusvalue = vms_status_to_unix(evalue);            \
+             set_vaxc_errno(evalue);                                   \
+             set_errno(PL_statusvalue);                                \
+             if (_x) PL_statusvalue = PL_statusvalue << 8;             \
+           }                                                           \
        } STMT_END
 #   ifdef VMSISH_STATUS
 #      define STATUS_CURRENT   (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX)
@@ -2499,8 +2576,13 @@ typedef pthread_key_t    perl_key;
        STMT_START {                                    \
            PL_statusvalue = (n);                               \
            if (PL_statusvalue != -1) {                 \
-               PL_statusvalue &= 0xFFFF;                       \
-               PL_statusvalue_vms = PL_statusvalue ? 44 : 1;   \
+               if (PL_statusvalue != EVMSERR) {                \
+                 PL_statusvalue &= 0xFFFF;                     \
+                 PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \
+               }                                               \
+               else {                                          \
+                 PL_statusvalue_vms = vaxc$errno;              \
+               }                                               \
            }                                           \
            else PL_statusvalue_vms = -1;                       \
        } STMT_END
@@ -2510,6 +2592,7 @@ typedef pthread_key_t     perl_key;
 #   define STATUS_NATIVE       PL_statusvalue_posix
 #   define STATUS_NATIVE_EXPORT        STATUS_NATIVE
 #   if defined(WCOREDUMP)
+#       define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n)
 #       define STATUS_NATIVE_SET(n)                        \
             STMT_START {                                   \
                 PL_statusvalue_posix = (n);                \
@@ -2523,6 +2606,7 @@ typedef pthread_key_t     perl_key;
                 }                                          \
             } STMT_END
 #   elif defined(WIFEXITED)
+#       define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n)
 #       define STATUS_NATIVE_SET(n)                        \
             STMT_START {                                   \
                 PL_statusvalue_posix = (n);                \
@@ -2535,6 +2619,7 @@ typedef pthread_key_t     perl_key;
                 }                                          \
             } STMT_END
 #   else
+#       define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n)
 #       define STATUS_NATIVE_SET(n)                        \
             STMT_START {                                   \
                 PL_statusvalue_posix = (n);                \
@@ -2609,35 +2694,53 @@ typedef pthread_key_t   perl_key;
 #  define PERL_SET_THX(t)              PERL_SET_CONTEXT(t)
 #endif
 
-/*  This replaces the previous %_ "hack" by the "%-p" hack
+/* 
+    This replaces the previous %_ "hack" by the "%p" hacks.
     All that is required is that the perl source does not
-    use "%-p" or "%-<number>p" format.  These format will
-    still work in perl code.   RMB 2005/05/17
+    use "%-p" or "%-<number>p" or "%<number>p" formats.  
+    These formats will still work in perl code.   
+    See comments in sv.c for futher details.
+
+       -DvdNUMBER=<number> can be used to redefine VDf
+
+       -DvdNUMBER=0 reverts VDf to "vd", as in perl5.8.7,
+           which works properly but gives compiler warnings
+
+    Robin Barker 2005-07-14
 */
-#ifndef SVf
-#  define SVf "-p"
+
+#ifndef SVf_
+#  define SVf_(n) "-" STRINGIFY(n) "p"
 #endif
 
-#ifndef SVf_precision
-#  define SVf_precision(n) "-" n "p"
+#ifndef SVf
+#  define SVf "-p"
 #endif
 
 #ifndef SVf32
-#  define SVf32 SVf_precision("32")
+#  define SVf32 SVf_(32)
 #endif
 
 #ifndef SVf256
-#  define SVf256 SVf_precision("256")
+#  define SVf256 SVf_(256)
+#endif
+
+#ifndef vdNUMBER
+#  define vdNUMBER 1
+#endif
+#ifndef VDf
+#  if vdNUMBER 
+#    define VDf STRINGIFY(vdNUMBER) "p"
+#  else
+#    define VDf "vd"
+#  endif
 #endif
  
 #ifndef UVf
 #  define UVf UVuf
 #endif
 
-#ifndef DieNull
-#  define DieNull Perl_vdie(aTHX_ Nullch, Null(va_list *))
-#endif
-
 #ifdef HASATTRIBUTE_FORMAT
 #  define __attribute__format__(x,y,z)      __attribute__((format(x,y,z)))
 #endif
@@ -3381,7 +3484,7 @@ char *getlogin (void);
 
 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
 #define UNLINK unlnk
-I32 unlnk (char*);
+I32 unlnk (const char*);
 #else
 #define UNLINK PerlLIO_unlink
 #endif
@@ -4050,8 +4153,10 @@ START_EXTERN_C
 
 #ifdef DOINIT
 #  define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {a,b,c,d,e,f,g}
+#  define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g} /* Like MGVTBL_SET but with the get magic having a const MG* */
 #else
 #  define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
+#  define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
 #endif
 
 MGVTBL_SET(
@@ -4172,7 +4277,7 @@ MGVTBL_SET(
     NULL
 );
 
-MGVTBL_SET(
+MGVTBL_SET_CONST_MAGIC_GET(
     PL_vtbl_arylen,
     MEMBER_TO_FPTR(Perl_magic_getarylen),
     MEMBER_TO_FPTR(Perl_magic_setarylen),