#define USE_STDIO
#endif /* PERL_FOR_X2P */
-#if defined(DGUX)
-#include <sys/fcntl.h>
-#endif
-
#ifdef VOIDUSED
# undef VOIDUSED
#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(__SYMBIAN32__)
-/* EPOC/Symbian: need to work around the SDK features. *
+#if defined(__SYMBIAN32__)
+/* Symbian: need to work around the SDK features. *
* On WINS: MS VC5 generates calls to _chkstk, *
* if a "large" stack frame is allocated. *
* gcc on MARM does not generate calls like these. */
# endif
#endif
-#define pVAR register struct perl_vars* my_vars PERL_UNUSED_DECL
+#define pVAR struct perl_vars* my_vars PERL_UNUSED_DECL
#ifdef PERL_GLOBAL_STRUCT
# define dVAR pVAR = (struct perl_vars*)PERL_GET_VARS()
# define MULTIPLICITY
# endif
# define tTHX PerlInterpreter*
-# define pTHX register tTHX my_perl PERL_UNUSED_DECL
+# define pTHX tTHX my_perl PERL_UNUSED_DECL
# define aTHX my_perl
+# define aTHXa(a) aTHX = (tTHX)a
# ifdef PERL_GLOBAL_STRUCT
# define dTHXa(a) dVAR; pTHX = (tTHX)a
# else
#define CALLREGCOMP(sv, flags) Perl_pregcomp(aTHX_ (sv),(flags))
#define CALLREGCOMP_ENG(prog, sv, flags) (prog)->comp(aTHX_ sv, flags)
-#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \
+#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,sv,data,flags) \
RX_ENGINE(prog)->exec(aTHX_ (prog),(stringarg),(strend), \
- (strbeg),(minend),(screamer),(data),(flags))
-#define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \
- RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strpos), \
+ (strbeg),(minend),(sv),(data),(flags))
+#define CALLREG_INTUIT_START(prog,sv,strbeg,strpos,strend,flags,data) \
+ RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strbeg), (strpos), \
(strend),(flags),(data))
#define CALLREG_INTUIT_STRING(prog) \
RX_ENGINE(prog)->checkstr(aTHX_ (prog))
# define pTHX_
# define aTHX
# define aTHX_
+# define aTHXa(a) NOOP
# define dTHXa(a) dNOOP
# define dTHX dNOOP
# define pTHX_1 1
#endif
#ifndef pTHXx
-# define pTHXx register PerlInterpreter *my_perl
+# define pTHXx PerlInterpreter *my_perl
# define pTHXx_ pTHXx,
# define aTHXx my_perl
# define aTHXx_ aTHXx,
# ifdef __GNUC__
# define stringify_immed(s) #s
# define stringify(s) stringify_immed(s)
-register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
+struct op *Perl_op asm(stringify(OP_IN_REGISTER));
# endif
#endif
#define DOSISH 1
#endif
-#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(EPOC) || defined(NETWARE) || defined(__SYMBIAN32__)
+#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || 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(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
# define DONT_DECLARE_STD 1
#endif
* silently ignores -t/-T instead of throwing an exception.
*
* DANGER! Using NO_TAINT_SUPPORT or SILENT_NO_TAINT_SUPPORT
- * voids your non-existant warranty!
+ * voids your nonexistent warranty!
*/
#if SILENT_NO_TAINT_SUPPORT && !defined(NO_TAINT_SUPPORT)
# define NO_TAINT_SUPPORT 1
#else
# define TAINT (PL_tainted = TRUE)
# define TAINT_NOT (PL_tainted = FALSE)
-# define TAINT_IF(c) if (c) { PL_tainted = TRUE; }
-# define TAINT_ENV() if (PL_tainting) { taint_env(); }
-# define TAINT_PROPER(s) if (PL_tainting) { taint_proper(NULL, s); }
+# define TAINT_IF(c) if (UNLIKELY(c)) { PL_tainted = TRUE; }
+# define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); }
+# define TAINT_PROPER(s) if (UNLIKELY(PL_tainting)) { taint_proper(NULL, s); }
# define TAINT_set(s) (PL_tainted = (s))
# define TAINT_get (PL_tainted)
# define TAINTING_get (PL_tainting)
#if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
# define USE_LOCALE
+# define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
+ capability */
# if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
&& defined(HAS_STRXFRM)
# define USE_LOCALE_COLLATE
# if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC)
# define USE_LOCALE_NUMERIC
# endif
+# if !defined(NO_LOCALE_MESSAGES) && defined(LC_MESSAGES)
+# define USE_LOCALE_MESSAGES
+# endif
+# if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY)
+# define USE_LOCALE_MONETARY
+# endif
#endif /* !NO_LOCALE && HAS_SETLOCALE */
#include <setjmp.h>
EXTERN_C int usleep(unsigned int);
#endif
-/* Funky places that do not have socket stuff. */
-#if defined(__LIBCATAMOUNT__)
-# define MYSWAP
-#endif
-
-#ifdef PERL_MICRO /* Last chance to export Perl_my_swap */
-# define MYSWAP
-#endif
-
#ifdef PERL_CORE
/* macros for correct constant construction */
(((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) ))
# endif
-/*----------------------------------------------------------------------------*/
-# if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 /* little-endian */
-/*----------------------------------------------------------------------------*/
-# define my_htole16(x) (x)
-# define my_letoh16(x) (x)
-# define my_htole32(x) (x)
-# define my_letoh32(x) (x)
-# define my_htobe16(x) _swab_16_(x)
-# define my_betoh16(x) _swab_16_(x)
-# define my_htobe32(x) _swab_32_(x)
-# define my_betoh32(x) _swab_32_(x)
-# ifdef HAS_QUAD
-# define my_htole64(x) (x)
-# define my_letoh64(x) (x)
-# define my_htobe64(x) _swab_64_(x)
-# define my_betoh64(x) _swab_64_(x)
-# endif
-# define my_htoles(x) (x)
-# define my_letohs(x) (x)
-# define my_htolei(x) (x)
-# define my_letohi(x) (x)
-# define my_htolel(x) (x)
-# define my_letohl(x) (x)
-# if SHORTSIZE == 1
-# define my_htobes(x) (x)
-# define my_betohs(x) (x)
-# elif SHORTSIZE == 2
-# define my_htobes(x) _swab_16_(x)
-# define my_betohs(x) _swab_16_(x)
-# elif SHORTSIZE == 4
-# define my_htobes(x) _swab_32_(x)
-# define my_betohs(x) _swab_32_(x)
-# elif SHORTSIZE == 8
-# define my_htobes(x) _swab_64_(x)
-# define my_betohs(x) _swab_64_(x)
-# else
-# define PERL_NEED_MY_HTOBES
-# define PERL_NEED_MY_BETOHS
-# endif
-# if INTSIZE == 1
-# define my_htobei(x) (x)
-# define my_betohi(x) (x)
-# elif INTSIZE == 2
-# define my_htobei(x) _swab_16_(x)
-# define my_betohi(x) _swab_16_(x)
-# elif INTSIZE == 4
-# define my_htobei(x) _swab_32_(x)
-# define my_betohi(x) _swab_32_(x)
-# elif INTSIZE == 8
-# define my_htobei(x) _swab_64_(x)
-# define my_betohi(x) _swab_64_(x)
-# else
-# define PERL_NEED_MY_HTOBEI
-# define PERL_NEED_MY_BETOHI
-# endif
-# if LONGSIZE == 1
-# define my_htobel(x) (x)
-# define my_betohl(x) (x)
-# elif LONGSIZE == 2
-# define my_htobel(x) _swab_16_(x)
-# define my_betohl(x) _swab_16_(x)
-# elif LONGSIZE == 4
-# define my_htobel(x) _swab_32_(x)
-# define my_betohl(x) _swab_32_(x)
-# elif LONGSIZE == 8
-# define my_htobel(x) _swab_64_(x)
-# define my_betohl(x) _swab_64_(x)
-# else
-# define PERL_NEED_MY_HTOBEL
-# define PERL_NEED_MY_BETOHL
-# endif
-# define my_htolen(p,n) NOOP
-# define my_letohn(p,n) NOOP
-# define my_htoben(p,n) my_swabn(p,n)
-# define my_betohn(p,n) my_swabn(p,n)
-/*----------------------------------------------------------------------------*/
-# elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 /* big-endian */
-/*----------------------------------------------------------------------------*/
-# define my_htobe16(x) (x)
-# define my_betoh16(x) (x)
-# define my_htobe32(x) (x)
-# define my_betoh32(x) (x)
-# define my_htole16(x) _swab_16_(x)
-# define my_letoh16(x) _swab_16_(x)
-# define my_htole32(x) _swab_32_(x)
-# define my_letoh32(x) _swab_32_(x)
-# ifdef HAS_QUAD
-# define my_htobe64(x) (x)
-# define my_betoh64(x) (x)
-# define my_htole64(x) _swab_64_(x)
-# define my_letoh64(x) _swab_64_(x)
-# endif
-# define my_htobes(x) (x)
-# define my_betohs(x) (x)
-# define my_htobei(x) (x)
-# define my_betohi(x) (x)
-# define my_htobel(x) (x)
-# define my_betohl(x) (x)
-# if SHORTSIZE == 1
-# define my_htoles(x) (x)
-# define my_letohs(x) (x)
-# elif SHORTSIZE == 2
-# define my_htoles(x) _swab_16_(x)
-# define my_letohs(x) _swab_16_(x)
-# elif SHORTSIZE == 4
-# define my_htoles(x) _swab_32_(x)
-# define my_letohs(x) _swab_32_(x)
-# elif SHORTSIZE == 8
-# define my_htoles(x) _swab_64_(x)
-# define my_letohs(x) _swab_64_(x)
-# else
-# define PERL_NEED_MY_HTOLES
-# define PERL_NEED_MY_LETOHS
-# endif
-# if INTSIZE == 1
-# define my_htolei(x) (x)
-# define my_letohi(x) (x)
-# elif INTSIZE == 2
-# define my_htolei(x) _swab_16_(x)
-# define my_letohi(x) _swab_16_(x)
-# elif INTSIZE == 4
-# define my_htolei(x) _swab_32_(x)
-# define my_letohi(x) _swab_32_(x)
-# elif INTSIZE == 8
-# define my_htolei(x) _swab_64_(x)
-# define my_letohi(x) _swab_64_(x)
-# else
-# define PERL_NEED_MY_HTOLEI
-# define PERL_NEED_MY_LETOHI
-# endif
-# if LONGSIZE == 1
-# define my_htolel(x) (x)
-# define my_letohl(x) (x)
-# elif LONGSIZE == 2
-# define my_htolel(x) _swab_16_(x)
-# define my_letohl(x) _swab_16_(x)
-# elif LONGSIZE == 4
-# define my_htolel(x) _swab_32_(x)
-# define my_letohl(x) _swab_32_(x)
-# elif LONGSIZE == 8
-# define my_htolel(x) _swab_64_(x)
-# define my_letohl(x) _swab_64_(x)
-# else
-# define PERL_NEED_MY_HTOLEL
-# define PERL_NEED_MY_LETOHL
-# endif
-# define my_htolen(p,n) my_swabn(p,n)
-# define my_letohn(p,n) my_swabn(p,n)
-# define my_htoben(p,n) NOOP
-# define my_betohn(p,n) NOOP
-/*----------------------------------------------------------------------------*/
-# else /* all other byte-orders */
-/*----------------------------------------------------------------------------*/
-# define PERL_NEED_MY_HTOLE16
-# define PERL_NEED_MY_LETOH16
-# define PERL_NEED_MY_HTOBE16
-# define PERL_NEED_MY_BETOH16
-# define PERL_NEED_MY_HTOLE32
-# define PERL_NEED_MY_LETOH32
-# define PERL_NEED_MY_HTOBE32
-# define PERL_NEED_MY_BETOH32
-# ifdef HAS_QUAD
-# define PERL_NEED_MY_HTOLE64
-# define PERL_NEED_MY_LETOH64
-# define PERL_NEED_MY_HTOBE64
-# define PERL_NEED_MY_BETOH64
-# endif
-# define PERL_NEED_MY_HTOLES
-# define PERL_NEED_MY_LETOHS
-# define PERL_NEED_MY_HTOBES
-# define PERL_NEED_MY_BETOHS
-# define PERL_NEED_MY_HTOLEI
-# define PERL_NEED_MY_LETOHI
-# define PERL_NEED_MY_HTOBEI
-# define PERL_NEED_MY_BETOHI
-# define PERL_NEED_MY_HTOLEL
-# define PERL_NEED_MY_LETOHL
-# define PERL_NEED_MY_HTOBEL
-# define PERL_NEED_MY_BETOHL
-/*----------------------------------------------------------------------------*/
-# endif /* end of byte-order macros */
-/*----------------------------------------------------------------------------*/
-
/* The old value was hard coded at 1008. (4096-16) seems to be a bit faster,
at least on FreeBSD. YMMV, so experiment. */
#ifndef PERL_ARENA_SIZE
#define PERL_USES_PL_PIDSTATUS
#endif
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(__SYMBIAN32__)
#define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
#endif
# define SS_IVCHAN SS$_IVCHAN
# define SS_NORMAL SS$_NORMAL
#else
-# define SETERRNO(errcode,vmserrcode) (errno = (errcode))
-# define dSAVEDERRNO int saved_errno
-# define dSAVE_ERRNO int saved_errno = errno
-# define SAVE_ERRNO (saved_errno = errno)
-# define RESTORE_ERRNO (errno = saved_errno)
-
# define LIB_INVARG 0
# define RMS_DIR 0
# define RMS_FAC 0
# define SS_NORMAL 0
#endif
+#ifdef WIN32
+# define dSAVEDERRNO int saved_errno; DWORD saved_win32_errno
+# define dSAVE_ERRNO int saved_errno = errno; DWORD saved_win32_errno = GetLastError()
+# define SAVE_ERRNO ( saved_errno = errno, saved_win32_errno = GetLastError() )
+# define RESTORE_ERRNO ( errno = saved_errno, SetLastError(saved_win32_errno) )
+#endif
+
+#ifdef OS2
+# define dSAVEDERRNO int saved_errno; unsigned long saved_os2_errno
+# define dSAVE_ERRNO int saved_errno = errno; unsigned long saved_os2_errno = Perl_rc
+# define SAVE_ERRNO ( saved_errno = errno, saved_os2_errno = Perl_rc )
+# define RESTORE_ERRNO ( errno = saved_errno, Perl_rc = saved_os2_errno )
+#endif
+
+#ifndef SETERRNO
+# define SETERRNO(errcode,vmserrcode) (errno = (errcode))
+#endif
+
+#ifndef dSAVEDERRNO
+# define dSAVEDERRNO int saved_errno
+# define dSAVE_ERRNO int saved_errno = errno
+# define SAVE_ERRNO (saved_errno = errno)
+# define RESTORE_ERRNO (errno = saved_errno)
+#endif
+
#define ERRSV GvSVn(PL_errgv)
#define CLEAR_ERRSV() STMT_START { \
#endif
#ifdef HAS_STRERROR
-#ifndef DONT_DECLARE_STD
+# ifndef DONT_DECLARE_STD
# ifdef VMS
char *strerror (int,...);
# else
char *strerror (int);
# endif
-#endif
-# ifndef Strerror
-# define Strerror strerror
-# endif
+# endif
+# ifndef Strerror
+# define Strerror strerror
+# endif
#else
# ifdef HAS_SYS_ERRLIST
extern int sys_nerr;
# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
#endif
-/*
BeOS 5.0 and Haiku R1 seem to define S_IREAD and S_IWRITE in <posix/fcntl.h>
+/*
Haiku R1 seems to define S_IREAD and S_IWRITE in <posix/fcntl.h>
* which would get included through <sys/file.h >, but that is 3000
* lines in the future. --jhi */
-#if !defined(S_IREAD) && !(defined(__BEOS__) || defined(__HAIKU__))
+#if !defined(S_IREAD) && !defined(__HAIKU__)
# define S_IREAD S_IRUSR
#endif
-#if !defined(S_IWRITE) && !(defined(__BEOS__) || defined(__HAIKU__))
+#if !defined(S_IWRITE) && !defined(__HAIKU__)
# define S_IWRITE S_IWUSR
#endif
#if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; })
+# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (Size_t)(len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; })
# define PERL_MY_VSNPRINTF_GUARDED
# else
# define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__)
# endif
#endif
+#define SSize_t_MAX (SSize_t)(~(size_t)0 >> 1)
+
#ifndef HAS_QUAD
# undef PERL_NEED_MY_HTOLE64
# undef PERL_NEED_MY_LETOH64
typedef struct xpvnv XPVNV;
typedef struct xpvmg XPVMG;
typedef struct xpvlv XPVLV;
+typedef struct xpvinvlist XINVLIST;
typedef struct xpvav XPVAV;
typedef struct xpvhv XPVHV;
typedef struct xpvgv XPVGV;
typedef AV PADNAMELIST;
typedef SV PADNAME;
+/* enable PERL_NEW_COPY_ON_WRITE by default */
+#if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW)
+# define PERL_NEW_COPY_ON_WRITE
+#endif
+
+#if defined(PERL_OLD_COPY_ON_WRITE) || defined(PERL_NEW_COPY_ON_WRITE)
+# if defined(PERL_OLD_COPY_ON_WRITE) && defined(PERL_NEW_COPY_ON_WRITE)
+# error PERL_OLD_COPY_ON_WRITE and PERL_NEW_COPY_ON_WRITE are exclusive
+# else
+# define PERL_ANY_COW
+# endif
+#else
+# define PERL_SAWAMPERSAND
+#endif
+
#include "handy.h"
#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
# define ISHISH "vos"
#endif
-#if defined(EPOC)
-# include "epocish.h"
-# define ISHISH "epoc"
-#endif
-
#ifdef __SYMBIAN32__
# include "symbian/symbianish.h"
# define ISHISH "symbian"
#if defined(__HAIKU__)
# include "haiku/haikuish.h"
# define ISHISH "haiku"
-#elif defined(__BEOS__)
-# include "beos/beosish.h"
-# define ISHISH "beos"
#endif
#ifndef ISHISH
# ifdef NETWARE
# include <nw5thread.h>
# else
-# ifdef FAKE_THREADS
-# include "fakethr.h"
-# else
# ifdef WIN32
# include <win32thread.h>
# else
# endif /* I_MACH_CTHREADS */
# endif /* OS2 */
# endif /* WIN32 */
-# endif /* FAKE_THREADS */
-#endif /* NETWARE */
+# endif /* NETWARE */
#endif /* USE_ITHREADS */
#if defined(WIN32)
/* flags in PL_exit_flags for nature of exit() */
#define PERL_EXIT_EXPECTED 0x01
#define PERL_EXIT_DESTRUCT_END 0x02 /* Run END in perl_destruct */
+#define PERL_EXIT_WARN 0x04 /* Warn if Perl_my_exit() or Perl_my_failure_exit() called */
+#define PERL_EXIT_ABORT 0x08 /* Call abort() if Perl_my_exit() or Perl_my_failure_exit() called */
#ifndef PERL_CORE
/* format to use for version numbers in file/directory names */
#define HEKfARG(p) ((void*)(p))
+/* Takes three arguments: is_utf8, length, str */
+#ifndef UTF8f
+# define UTF8f "d%"UVuf"%4p"
+#endif
+#define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p)
+
#ifdef PERL_CORE
/* not used; but needed for backward compatibility with XS code? - RMB */
# undef VDf
#else
# define EXPECT(expr,val) (expr)
#endif
-#define LIKELY(cond) EXPECT(cond,1)
-#define UNLIKELY(cond) EXPECT(cond,0)
+#define LIKELY(cond) EXPECT(cBOOL(cond),TRUE)
+#define UNLIKELY(cond) EXPECT(cBOOL(cond),FALSE)
#ifdef HAS_BUILTIN_CHOOSE_EXPR
/* placeholder */
#endif
#define HAS_NTOHS
#endif
#ifndef HAS_HTONL
-#if (BYTEORDER & 0xffff) != 0x4321
#define HAS_HTONS
#define HAS_HTONL
#define HAS_NTOHS
#define HAS_NTOHL
-#define MYSWAP
-#define htons my_swap
-#define htonl my_htonl
-#define ntohs my_swap
-#define ntohl my_ntohl
-#endif
-#else
-#if (BYTEORDER & 0xffff) == 0x4321
-#undef HAS_HTONS
-#undef HAS_HTONL
-#undef HAS_NTOHS
-#undef HAS_NTOHL
-#endif
+# if (BYTEORDER & 0xffff) == 0x4321
+/* Big endian system, so ntohl, ntohs, htonl and htons do not need to
+ re-order their values. However, to behave identically to the alternative
+ implementations, they should truncate to the correct size. */
+# define ntohl(x) ((x)&0xFFFFFFFF)
+# define htonl(x) ntohl(x)
+# define ntohs(x) ((x)&0xFFFF)
+# define htons(x) ntohs(x)
+# elif BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+
+/* Note that we can't straight out declare our own htonl and htons because
+ the Win32 build process forcibly undefines HAS_HTONL etc for its miniperl,
+ to avoid the overhead of initialising the socket subsystem, but the headers
+ that *declare* the various functions are still seen. If we declare our own
+ htonl etc they will clash with the declarations in the Win32 headers. */
+
+PERL_STATIC_INLINE U32
+my_swap32(const U32 x) {
+ return ((x & 0xFF) << 24) | ((x >> 24) & 0xFF)
+ | ((x & 0x0000FF00) << 8) | ((x & 0x00FF0000) >> 8);
+}
+
+PERL_STATIC_INLINE U16
+my_swap16(const U16 x) {
+ return ((x & 0xFF) << 8) | ((x >> 8) & 0xFF);
+}
+
+# define htonl(x) my_swap32(x)
+# define ntohl(x) my_swap32(x)
+# define ntohs(x) my_swap16(x)
+# define htons(x) my_swap16(x)
+# else
+# error "Unsupported byteorder"
+/* The C pre-processor doesn't let us return the value of BYTEORDER as part of
+ the error message. Please check the value of the macro BYTEORDER, as defined
+ in config.h. The values of BYTEORDER we expect are
+
+ big endian little endian
+ 32 bit 0x4321 0x1234
+ 64 bit 0x87654321 0x12345678
+
+ If you have a system with a different byte order, please see
+ pod/perlhack.pod for how to submit a patch to add supporting code.
+*/
+# endif
#endif
/*
* Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
* -DWS
*/
-#if BYTEORDER != 0x1234
-# define HAS_VTOHL
-# define HAS_VTOHS
-# define HAS_HTOVL
-# define HAS_HTOVS
-# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+/* Little endian system, so vtohl, vtohs, htovl and htovs do not need to
+ re-order their values. However, to behave identically to the alternative
+ implementations, they should truncate to the correct size. */
+# define vtohl(x) ((x)&0xFFFFFFFF)
+# define vtohs(x) ((x)&0xFFFF)
+# define htovl(x) vtohl(x)
+# define htovs(x) vtohs(x)
+#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
# define vtohl(x) ((((x)&0xFF)<<24) \
+(((x)>>24)&0xFF) \
+(((x)&0x0000FF00)<<8) \
# define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
# define htovl(x) vtohl(x)
# define htovs(x) vtohs(x)
-# endif
- /* otherwise default to functions in util.c */
-#ifndef htovs
-short htovs(short n);
-short vtohs(short n);
-long htovl(long n);
-long vtohl(long n);
-#endif
+#else
+# error "Unsupported byteorder"
+/* If you have need for current perl on PDP-11 or similar, and can help test
+ that blead keeps working on a mixed-endian system, then see
+ pod/perlhack.pod for how to submit patches to things working again. */
#endif
/* *MAX Plus 1. A floating point value.
# ifndef getenv
char *getenv (const char*);
# endif /* !getenv */
-# if !defined(HAS_LSEEK_PROTO) && !defined(EPOC) && !defined(__hpux)
+# if !defined(HAS_LSEEK_PROTO) && !defined(__hpux)
# ifdef _FILE_OFFSET_BITS
# if _FILE_OFFSET_BITS == 64
Off_t lseek (int,Off_t,int);
# ifdef USE_ENVIRON_ARRAY
# if !defined(DONT_DECLARE_STD) || \
(defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
- defined(__sgi) || \
- defined(__DGUX)
+ defined(__sgi)
extern char ** environ; /* environment variables supplied via exec */
# endif
# endif
INIT("Modification of non-creatable hash value attempted, subscript \"%"SVf"\"");
EXTCONST char PL_no_modify[]
INIT("Modification of a read-only value attempted");
-EXTCONST char PL_no_mem[]
+EXTCONST char PL_no_mem[sizeof("Out of memory!\n")]
INIT("Out of memory!\n");
EXTCONST char PL_no_security[]
INIT("Insecure dependency in %s%s");
248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32,
255 /* y with diaeresis */
};
-#endif /* !EBCDIC, but still in DOINIT */
/* If these tables are accessed through ebcdic, the access will be converted to
* latin1 first */
240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247,
248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, 255
};
+#endif /* !EBCDIC, but still in DOINIT */
#else /* ! DOINIT */
+# ifndef EBCDIC
EXTCONST unsigned char PL_fold[];
EXTCONST unsigned char PL_fold_latin1[];
EXTCONST unsigned char PL_mod_latin1_uc[];
EXTCONST unsigned char PL_latin1_lc[];
+# endif
#endif
#ifndef PERL_GLOBAL_STRUCT /* or perlvars.h */
# ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
" DEBUG_LEAKING_SCALARS_FORK_DUMP"
# endif
-# ifdef FAKE_THREADS
- " FAKE_THREADS"
-# endif
# ifdef FCRYPT
" FCRYPT"
# endif
# ifdef PERL_POISON
" PERL_POISON"
# endif
+# ifdef PERL_SAWAMPERSAND
+ " PERL_SAWAMPERSAND"
+# endif
# ifdef PERL_TRACK_MEMPOOL
" PERL_TRACK_MEMPOOL"
# endif
# define PL_amagic_generation PL_na
#endif /* !PERL_CORE */
+#define PL_hints PL_compiling.cop_hints
+
END_EXTERN_C
/*****************************************************************************/
#define SAWAMPERSAND_MIDDLE 2 /* saw $& */
#define SAWAMPERSAND_RIGHT 4 /* saw $' */
+#ifndef PERL_SAWAMPERSAND
+# define PL_sawampersand \
+ (SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT)
+#endif
+
/* Various states of the input record separator SV (rs) */
#define RsSNARF(sv) (! SvOK(sv))
#define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))
/* Set up PERLVAR macros for populating structs */
# define PERLVAR(prefix,var,type) type prefix##var;
+
+/* 'var' is an array of length 'n' */
# define PERLVARA(prefix,var,n,type) type prefix##var[n];
+
+/* initialize 'var' to init' */
# define PERLVARI(prefix,var,type,init) type prefix##var;
+
+/* like PERLVARI, but make 'var' a const */
# define PERLVARIC(prefix,var,type,init) type prefix##var;
struct interpreter {
/* This will be useful for subsequent releases, because this has to be the
same in your libperl as in main(), else you have a mismatch and must abort.
*/
-EXTCONST U16 PL_interp_size_5_16_0
- INIT(PERL_INTERPRETER_SIZE_UPTO_MEMBER(PERL_LAST_5_16_0_INTERP_MEMBER));
+EXTCONST U16 PL_interp_size_5_18_0
+ INIT(PERL_INTERPRETER_SIZE_UPTO_MEMBER(PERL_LAST_5_18_0_INTERP_MEMBER));
# ifdef PERL_GLOBAL_STRUCT
#endif
#ifdef DOINIT
- /* NL BD IV NV PV PI PN MG RX GV LV AV HV CV FM IO */
+ /* NL IV NV PV INV PI PN MG RX GV LV AV HV CV FM IO */
EXTCONST bool
-PL_valid_types_IVX[] = { 0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
+PL_valid_types_IVX[] = { 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
EXTCONST bool
-PL_valid_types_NVX[] = { 0, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
+PL_valid_types_NVX[] = { 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
EXTCONST bool
-PL_valid_types_PVX[] = { 0, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1, 1 };
+PL_valid_types_PVX[] = { 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1, 1 };
EXTCONST bool
-PL_valid_types_RV[] = { 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1 };
+PL_valid_types_RV[] = { 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1 };
EXTCONST bool
-PL_valid_types_IV_set[] = { 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1 };
+PL_valid_types_IV_set[] = { 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1 };
EXTCONST bool
-PL_valid_types_NV_set[] = { 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 };
+PL_valid_types_NV_set[] = { 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 };
#else
#endif
-/* Static inline funcs that depend on includes and declarations above */
-#include "inline.h"
+#ifndef PERL_NO_INLINE_FUNCTIONS
+/* Static inline funcs that depend on includes and declarations above.
+ Some of these reference functions in the perl object files, and some
+ compilers aren't smart enough to eliminate unused static inline
+ functions, so including this file in source code can cause link errors
+ even if the source code uses none of the functions. Hence including these
+ can be be suppressed by setting PERL_NO_INLINE_FUNCTIONS. Doing this will
+ (obviously) result in unworkable XS code, but allows simple probing code
+ to continue to work, because it permits tests to include the perl headers
+ for definitions without creating a link dependency on the perl library
+ (which may not exist yet).
+*/
+
+# include "inline.h"
+#endif
#include "overload.h"
#define AMGfallYES 3
#define AMTf_AMAGIC 1
-#define AMTf_OVERLOADED 2
#define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC)
#define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC)
#define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC)
-#define AMT_OVERLOADED(amt) ((amt)->flags & AMTf_OVERLOADED)
-#define AMT_OVERLOADED_on(amt) ((amt)->flags |= AMTf_OVERLOADED)
-#define AMT_OVERLOADED_off(amt) ((amt)->flags &= ~AMTf_OVERLOADED)
#define StashHANDLER(stash,meth) gv_handler((stash),CAT2(meth,_amg))
#if O_TEXT != O_BINARY
/* If you have different O_TEXT and O_BINARY and you are a CLRF shop,
* that is, you are somehow DOSish. */
-# if defined(__BEOS__) || defined(__HAIKU__) || defined(__VOS__) || \
- defined(__CYGWIN__)
- /* BeOS/Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect;
- * BeOS/Haiku is always UNIXoid (LF), not DOSish (CRLF). */
+# if defined(__HAIKU__) || defined(__VOS__) || defined(__CYGWIN__)
+ /* Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect;
+ * Haiku is always UNIXoid (LF), not DOSish (CRLF). */
/* VOS has O_TEXT != O_BINARY, and they have effect,
* but VOS always uses LF, never CRLF. */
/* If you have O_TEXT different from your O_BINARY but you still are
# define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0)
#endif
+/* check embedded \0 characters in pathnames passed to syscalls,
+ but allow one ending \0 */
+#define IS_SAFE_SYSCALL(pv, what, op_name) (S_is_safe_syscall(aTHX_ (pv), (what), (op_name)))
+
+#define IS_SAFE_PATHNAME(pv, op_name) IS_SAFE_SYSCALL((pv), "pathname", (op_name))
+
#if defined(OEMVS)
#define NO_ENV_ARRAY_IN_MAIN
#endif
https://perl5.git.perl.org / perl5.git / blobdiff