# endif
#endif
-#ifdef SYMBIAN
+#ifdef __SYMBIAN32__
# include "symbian/symbian_proto.h"
#endif
/* Any stack-challenged places. The limit varies (and often
* is configurable), but using more than a kilobyte of stack
* is usually dubious in these systems. */
-#if defined(EPOC) || defined(SYMBIAN)
+#if defined(EPOC) || defined(__SYMBIAN32__)
/* EPOC/Symbian: need to work around the SDK features. *
* On WINS: MS VC5 generates calls to _chkstk, *
* if a "large" stack frame is allocated. *
#define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
#define CALLREGFREE CALL_FPTR(PL_regfree)
-#if defined(SYMBIAN) && defined(__GNUC__)
+/* 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
# else
#define DOSISH 1
#endif
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE) || defined(SYMBIAN)
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(EPOC) || defined(NETWARE) || defined(__SYMBIAN32__)
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined(EPOC) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
# define DONT_DECLARE_STD 1
#endif
# include <unistd.h>
#endif
-#ifdef SYMBIAN
+#ifdef __SYMBIAN32__
# undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */
#endif
# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
#endif
-#ifndef SYMBIAN
+#ifndef __SYMBIAN32__
# if defined(I_STRING) || defined(__cplusplus)
# include <string.h>
# else
# define ISHISH "epoc"
#endif
-#ifdef SYMBIAN
+#ifdef __SYMBIAN32__
# include "symbian/symbianish.h"
# include "embed.h"
# define ISHISH "symbian"
#define STATUS_UNIX PL_statusvalue
#ifdef VMS
# 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) \
+/*
+ * vaxc$errno is only guaranteed to be valid if errno == EVMSERR, otherwise
+ * it's contents can not be trusted. Unfortunately, Perl seems to check
+ * it on exit, so it when PL_statusvalue_vms is updated, vaxc$errno should
+ * be updated also.
+ */
+# include <stsdef.h>
+# include <ssdef.h>
+/* Presume this because if VMS changes it, it will require a new
+ * set of APIs for waiting on children for binary compatibility.
+ */
+# define child_offset_bits (8)
+# ifndef C_FAC_POSIX
+# define C_FAC_POSIX 0x35A000
+# endif
+
+/* STATUS_EXIT - validates and returns a NATIVE exit status code for the
+ * platform from the existing UNIX or Native status values.
+ */
+
+# define STATUS_EXIT \
+ (((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.
+ */
+
+# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET_PORC(n, 1)
+
+ /* internal convert VMS status codes to UNIX error or status codes */
+# 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; \
+ PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \
+ } else \
+ PL_statusvalue = Perl_vms_status_to_unix(evalue, _x); \
+ set_vaxc_errno(evalue); \
+ set_errno(PL_statusvalue); \
+ if (_x) PL_statusvalue = PL_statusvalue << child_offset_bits; \
+ } \
} STMT_END
+
# ifdef VMSISH_STATUS
# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX)
# else
# define STATUS_CURRENT STATUS_UNIX
# endif
+
+ /* STATUS_UNIX_SET - takes a UNIX/POSIX errno value and attempts to update
+ * the NATIVE status to an equivalent value. Can not be used to translate
+ * exit code values as exit code values are not guaranteed to have any
+ * relationship at all to errno values.
+ * This is used when Perl is forcing errno to have a specific value.
+ */
# define STATUS_UNIX_SET(n) \
STMT_START { \
- PL_statusvalue = (n); \
+ I32 evalue = (I32)n; \
+ PL_statusvalue = evalue; \
if (PL_statusvalue != -1) { \
- PL_statusvalue &= 0xFFFF; \
- PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \
+ if (PL_statusvalue != EVMSERR) { \
+ PL_statusvalue &= 0xFFFF; \
+ PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \
+ } \
+ else { \
+ PL_statusvalue_vms = vaxc$errno; \
+ } \
} \
- else PL_statusvalue_vms = -1; \
+ else PL_statusvalue_vms = SS$_ABORT; \
+ set_vaxc_errno(evalue); \
+ } 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.
+ */
+
+# 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; \
+ } \
+ } \
+ else PL_statusvalue_vms = SS$_ABORT; \
+ set_vaxc_errno(PL_statusvalue_vms); \
} STMT_END
-# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1)
-# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44)
+# define STATUS_ALL_SUCCESS \
+ (PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL)
+# 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
-# define STATUS_NATIVE_EXPORT STATUS_NATIVE
# if defined(WCOREDUMP)
-# define STATUS_NATIVE_SET(n) \
+# define STATUS_NATIVE_CHILD_SET(n) \
STMT_START { \
PL_statusvalue_posix = (n); \
if (PL_statusvalue_posix == -1) \
} \
} STMT_END
# elif defined(WIFEXITED)
-# define STATUS_NATIVE_SET(n) \
+# define STATUS_NATIVE_CHILD_SET(n) \
STMT_START { \
PL_statusvalue_posix = (n); \
if (PL_statusvalue_posix == -1) \
} \
} STMT_END
# else
-# define STATUS_NATIVE_SET(n) \
+# define STATUS_NATIVE_CHILD_SET(n) \
STMT_START { \
PL_statusvalue_posix = (n); \
if (PL_statusvalue_posix == -1) \
# define STATUS_UNIX_SET(n) \
STMT_START { \
PL_statusvalue = (n); \
- PL_statusvalue_posix = PL_statusvalue; \
if (PL_statusvalue != -1) \
PL_statusvalue &= 0xFFFF; \
} STMT_END
+# define STATUS_UNIX_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)
# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1)
#endif
*/
#ifndef SVf_
-# define SVf_(n) "-" #n "p"
+# define SVf_(n) "-" STRINGIFY(n) "p"
#endif
#ifndef SVf
#ifndef VDf
# if vdNUMBER
-# define vdFORMAT(n) #n "p"
-# define VDf_(n) vdFORMAT(n)
-# define VDf VDf_(vdNUMBER)
+# define VDf STRINGIFY(vdNUMBER) "p"
# else
# define VDf "vd"
# endif
#define DEBUG_SCOPE(where) \
DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n", \
- where, PL_scopestack_ix, __FILE__, __LINE__)));
+ where, (long)PL_scopestack_ix, __FILE__, __LINE__)));
#endif
#endif /* !__cplusplus */
+/* Fixme on VMS. This needs to be a run-time, not build time options */
+/* Also rename() is affected by this */
#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