X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=dd05dd11339f09d6a2d430b3ea2e6d6e1cf8f79f;hb=fb1ee0ec5828ec8a55002a46636da2e885a4fc4c;hp=11cfc75fdb369c768cd3a11749e9f95b9383483b;hpb=fb38d079f941c715cfb0486ced0d003ca5964c75;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.h b/perl.h
index 11cfc75..dd05dd1 100644
--- a/perl.h
+++ b/perl.h
@@ -148,12 +148,14 @@
 #  ifndef MULTIPLICITY
 #    define MULTIPLICITY
 #  endif
-#  define pTHX	register PerlInterpreter *my_perl PERL_UNUSED_DECL
+#  define tTHX	PerlInterpreter*
+#  define sTHX	(sizeof(tTHX) + (MEM_ALIGNBYTES - sizeof(tTHX)%MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
+#  define pTHX	register tTHX my_perl PERL_UNUSED_DECL
 #  define aTHX	my_perl
 #  ifdef PERL_GLOBAL_STRUCT
-#    define dTHXa(a)	dVAR; pTHX = (PerlInterpreter*)a
+#    define dTHXa(a)	dVAR; pTHX = (tTHX)a
 #  else
-#    define dTHXa(a)	pTHX = (PerlInterpreter*)a
+#    define dTHXa(a)	pTHX = (tTHX)a
 #  endif
 #  ifdef PERL_GLOBAL_STRUCT
 #    define dTHX		dVAR; pTHX = PERL_GET_THX
@@ -171,6 +173,11 @@
 #  define pTHX_7	8
 #  define pTHX_8	9
 #  define pTHX_9	10
+#  if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL)
+#    define PERL_TRACK_MEMPOOL
+#  endif
+#else
+#  undef PERL_TRACK_MEMPOOL
 #endif
 
 #define STATIC static
@@ -231,6 +238,9 @@
 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
 
 #ifndef pTHX
+/* Don't bother defining tTHX and sTHX; using them outside
+ * code guarded by PERL_IMPLICIT_CONTEXT is an error.
+ */
 #  define pTHX		void
 #  define pTHX_
 #  define aTHX
@@ -815,6 +825,14 @@ int usleep(unsigned int);
 #define PERL_DONT_CREATE_GVSV
 #endif
 
+#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
+#define PERL_USES_PL_PIDSTATUS
+#endif
+
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL)
+#define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
+#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
  */
@@ -1402,6 +1420,16 @@ int sockatmark(int);
 #  define sprintf UTS_sprintf_wrap
 #endif
 
+/* For the times when you want the return value of sprintf, and you want it
+   to be the length. Can't have a thread variable passed in, because C89 has
+   no varargs macros.
+*/
+#ifdef SPRINTF_RETURNS_STRLEN
+#  define my_sprintf sprintf
+#else
+#  define my_sprintf Perl_my_sprintf
+#endif
+
 /* Configure gets this right but the UTS compiler gets it wrong.
    -- Hal Morris <hom00@utsglobal.com> */
 #ifdef UTS
@@ -2632,26 +2660,28 @@ typedef pthread_key_t	perl_key;
 #   define STATUS_UNIX_SET(n)				\
 	STMT_START {					\
 	    I32 evalue = (I32)n;			\
-	    PL_statusvalue = evalue;				\
+	    PL_statusvalue = evalue;			\
 	    if (PL_statusvalue != -1) {			\
-		if (PL_statusvalue != EVMSERR) {		\
-		  PL_statusvalue &= 0xFFFF;			\
-		  PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \
-		}						\
-		else {						\
-		  PL_statusvalue_vms = vaxc$errno;		\
-		}						\
+		if (PL_statusvalue != EVMSERR) {	\
+		  PL_statusvalue &= 0xFFFF;		\
+		  if (MY_POSIX_EXIT)			\
+		    PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\
+		  else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \
+		}					\
+		else {					\
+		  PL_statusvalue_vms = vaxc$errno;	\
+		}					\
 	    }						\
-	    else PL_statusvalue_vms = SS$_ABORT;		\
-	    set_vaxc_errno(evalue);				\
+	    else PL_statusvalue_vms = SS$_ABORT;	\
+	    set_vaxc_errno(PL_statusvalue_vms);		\
 	} 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, anything other than 0 indicates
-   * a native status should be set to the failure code SS$_ABORT;
+   * with the Perl VMS documentation, 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
@@ -2675,8 +2705,9 @@ typedef pthread_key_t	perl_key;
 		  if (MY_POSIX_EXIT)			\
 		    PL_statusvalue_vms =	\
 		       (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
-		        (STS$K_ERROR | STS$M_INHIB_MSG) : 0); \
-		  else PL_statusvalue_vms = SS$_ABORT; \
+		        (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;		\
@@ -2688,6 +2719,33 @@ typedef pthread_key_t	perl_key;
 	    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.
+   *
+   * In the default mode on VMS, this number is passed through as
+   * both the NATIVE and UNIX status.  Which makes it different
+   * that the STATUS_UNIX_EXIT_SET.
+   *
+   * 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
+   * shell.
+   *
+   */
+
+#   define STATUS_EXIT_SET(n)				\
+	STMT_START {					\
+	    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); \
+	    else					\
+		PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \
+	    set_vaxc_errno(PL_statusvalue_vms);		\
+	} STMT_END
+
 
  /* This macro forces a success status */
 #   define STATUS_ALL_SUCCESS	\
@@ -2744,6 +2802,7 @@ typedef pthread_key_t	perl_key;
 		PL_statusvalue &= 0xFFFF;	\
 	} STMT_END
 #   define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n)
+#   define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n)
 #   define STATUS_CURRENT STATUS_UNIX
 #   define STATUS_EXIT STATUS_UNIX
 #   define STATUS_ALL_SUCCESS	(PL_statusvalue = 0, PL_statusvalue_posix = 0)
@@ -2914,11 +2973,16 @@ typedef pthread_key_t	perl_key;
 
 #ifndef IOCPARM_LEN
 #   ifdef IOCPARM_MASK
-	/* on BSDish systes we're safe */
+	/* on BSDish systems we're safe */
 #	define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
 #   else
+#	if defined(_IOC_SIZE) && defined(__GLIBC__)
+	/* on Linux systems we're safe */
+#	    define IOCPARM_LEN(x) _IOC_SIZE(x)
+#	else
 	/* otherwise guess at what's safe */
-#	define IOCPARM_LEN(x)	256
+#	    define IOCPARM_LEN(x)	256
+#	endif
 #   endif
 #endif
 
@@ -3736,10 +3800,8 @@ EXTCONST char PL_no_myglob[]
   INIT("\"my\" variable %s can't be in a package");
 EXTCONST char PL_no_localize_ref[]
   INIT("Can't localize through a reference");
-#ifdef PERL_MALLOC_WRAP
 EXTCONST char PL_memory_wrap[]
   INIT("panic: memory wrap");
-#endif
 
 EXTCONST char PL_uuemap[65]
   INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
@@ -5340,6 +5402,17 @@ extern void moncontrol(int);
 #pragma message disable (mainparm) /* Perl uses the envp in main(). */
 #endif
 
+#define do_open(g, n, l, a, rm, rp, sf) \
+	do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0)
+#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
+#  define do_exec(cmd)			do_exec3(cmd,0,0)
+#endif
+#ifdef OS2
+#  define do_aexec			Perl_do_aexec
+#else
+#  define do_aexec(really, mark,sp)	do_aexec5(really, mark, sp, 0, 0)
+#endif
+
 /* and finally... */
 #define PERL_PATCHLEVEL_H_IMPLICIT
 #include "patchlevel.h"