#define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
#define CALLREGFREE CALL_FPTR(PL_regfree)
+/* XXX The PERL_UNUSED_DECL suffix is unfortunately rather inflexible:
+ * it assumes that in all compilers the way to suppress an "unused"
+ * warning is to have a suffix. In some compilers that might be a
+ * a compiler pragma, e.g. #pragma unused(varname). */
+
#if defined(__SYMBIAN32__) && defined(__GNUC__)
# ifdef __cplusplus
# define PERL_UNUSED_DECL
#define DOSISH 1
#endif
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(EPOC) || defined(NETWARE) || defined(__SYMBIAN32__)
+#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(EPOC) || defined(NETWARE) || defined(__SYMBIAN32__)
# define STANDARD_C 1
#endif
#define PERL_DONT_CREATE_GVSV
#endif
+#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
+#define PERL_USES_PL_PIDSTATUS
+#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
*/
# 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
(((I32)PL_statusvalue_vms == -1 ? SS$_ABORT : PL_statusvalue_vms) | \
(VMSISH_HUSHED ? STS$M_INHIB_MSG : 0))
-/* STATUS_NATIVE_SET - takes a NATIVE status code and converts it to a
- * UNIX/POSIX status value and updates both the native and PL_statusvalue
- * as needed. This currently seems only exist for VMS and is used in the exit
- * handling.
- */
-
-# define STATUS_NATIVE_SET(n) STATUS_NATIVE_SET_PORC(n, 0)
-/* STATUS_NATIVE_CHILD_SET - same as STATUS_NATIVE_SET, but shifts the UNIX
- * value over the correct number of bits to be a child status. Usually
- * the number of bits is 8, but that could be platform dependent. The NATIVE
- * status code is presumed to have either from a child process.
+/* STATUS_NATIVE_CHILD_SET - Calculate UNIX status that matches the child
+ * exit code and shifts the UNIX value over the correct number of bits to
+ * be a child status. Usually the number of bits is 8, but that could be
+ * platform dependent. The NATIVE status code is presumed to have either
+ * from a child process.
*/
-# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET_PORC(n, 1)
+/* This is complicated. The child processes return a true native VMS
+ status which must be saved. But there is an assumption in Perl that
+ the UNIX child status has some relationship to errno values, so
+ Perl tries to translate it to text in some of the tests.
+ In order to get the string translation correct, for the error, errno
+ must be EVMSERR, but that generates a different text message
+ than what the test programs are expecting. So an errno value must
+ be derived from the native status value when an error occurs.
+ That will hide the true native status message. With this version of
+ perl, the true native child status can always be retrieved so that
+ is not a problem. But in this case, Pl_statusvalue and errno may
+ have different values in them.
+ */
- /* internal convert VMS status codes to UNIX error or status codes */
-# define STATUS_NATIVE_SET_PORC(n, _x) \
+# define STATUS_NATIVE_CHILD_SET(n) \
STMT_START { \
I32 evalue = (I32)n; \
if (evalue == EVMSERR) { \
PL_statusvalue = evalue; \
} else { \
PL_statusvalue_vms = evalue; \
- if ((I32)PL_statusvalue_vms == -1) { \
+ if (evalue == -1) { \
PL_statusvalue = -1; \
PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \
} else \
- PL_statusvalue = Perl_vms_status_to_unix(evalue, _x); \
+ PL_statusvalue = Perl_vms_status_to_unix(evalue, 1); \
set_vaxc_errno(evalue); \
- set_errno(PL_statusvalue); \
- if (_x) PL_statusvalue = PL_statusvalue << child_offset_bits; \
+ if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX) \
+ set_errno(EVMSERR); \
+ else set_errno(Perl_vms_status_to_unix(evalue, 0)); \
+ PL_statusvalue = PL_statusvalue << child_offset_bits; \
} \
} STMT_END
# 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
- * values and are only being encoded into the NATIVE form so
- * that they can be properly passed through to the calling
- * program or shell.
+ * 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.
+ *
+ * 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.
+ *
+ * If the exit code is not clearly a UNIX parent or child exit status,
+ * it will be passed through as a VMS status.
*/
-# define STATUS_UNIX_EXIT_SET(n) \
+# define STATUS_UNIX_EXIT_SET(n) \
STMT_START { \
I32 evalue = (I32)n; \
PL_statusvalue = evalue; \
- if (PL_statusvalue != -1) { \
- if (PL_statusvalue != EVMSERR) { \
- if (PL_statusvalue < 256) { \
- if (PL_statusvalue == 0) \
- PL_statusvalue_vms == SS$_NORMAL; \
- else \
- PL_statusvalue_vms = MY_POSIX_EXIT ? \
- (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
- (STS$K_ERROR | STS$M_INHIB_MSG) : 0) : evalue; \
- } else { /* forgive them Perl, for they have sinned */ \
- PL_statusvalue_vms = evalue; \
- } /* And obviously used a VMS status value instead of UNIX */ \
- PL_statusvalue = EVMSERR; \
- } \
- else { \
- PL_statusvalue_vms = vaxc$errno; \
- } \
+ 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); \
} 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 \
(PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL)
+
+ /* This macro forces a failure status */
# define STATUS_ALL_FAILURE (PL_statusvalue = 1, \
vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \
(C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT)
+
#else
# define STATUS_NATIVE PL_statusvalue_posix
# if defined(WCOREDUMP)
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)
#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
#pragma message disable (mainparm) /* Perl uses the envp in main(). */
#endif
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL)
+#define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
+#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"
projects / p5sagit/p5-mst-13.2.git / blobdiff