# 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(_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 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
# 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_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.
+ */
+
+/* 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.
+ */
+
+# define STATUS_NATIVE_CHILD_SET(n) \
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 (evalue == -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, 1); \
+ set_vaxc_errno(evalue); \
+ 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
+
# 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, 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;
+ *
+ * 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) \
+ 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) : 0); \
+ 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
-# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1)
-# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44)
+
+
+ /* 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
-# 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 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
#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