/* perl.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
# endif
#endif
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# ifndef PERL_GLOBAL_STRUCT
+# define PERL_GLOBAL_STRUCT
+# endif
+#endif
+#ifdef PERL_GLOBAL_STRUCT
+# ifndef MULTIPLICITY
+# define MULTIPLICITY
+# endif
+#endif
+
/* undef WIN32 when building on Cygwin (for libwin32) - gph */
#ifdef __CYGWIN__
# undef WIN32
# undef _WIN32
#endif
-/* Use the reentrant APIs like localtime_r and getpwent_r */
+#if defined(__SYMBIAN32__) || (defined(__VC32__) && defined(WINS))
+# ifndef SYMBIAN
+# define SYMBIAN
+# endif
+#endif
+
+#ifdef SYMBIAN
+# 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)
+/* EPOC/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. */
+# define USE_HEAP_INSTEAD_OF_STACK
+#endif
+
+#/* Use the reentrant APIs like localtime_r and getpwent_r */
/* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
-#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(DARWIN)
+#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN)
# define USE_REENTRANT_API
#endif
/* <--- here ends the logic shared by perl.h and makedef.pl */
/*
- * DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned)
- * (The -DDARWIN comes from the hints/darwin.sh.)
+ * PERL_DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned)
+ * (The -DPERL_DARWIN comes from the hints/darwin.sh.)
* __bsdi__ for BSD/OS
*/
-#if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44)
+#if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(PERL_DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44)
# ifndef BSDish
# define BSDish
# endif
#endif
+#ifdef PERL_GLOBAL_STRUCT
+# ifndef PERL_GET_VARS
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ extern struct perl_vars* Perl_GetVarsPrivate();
+# define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */
+# ifndef PERLIO_FUNCS_CONST
+# define PERLIO_FUNCS_CONST /* Can't have these lying around. */
+# endif
+# else
+# define PERL_GET_VARS() PL_VarsPtr
+# endif
+# endif
+#endif
+
+#define pVAR register struct perl_vars* my_vars PERL_UNUSED_DECL
+
+#ifdef PERL_GLOBAL_STRUCT
+# define dVAR pVAR = (struct perl_vars*)PERL_GET_VARS()
+#else
+# define dVAR dNOOP
+#endif
+
#ifdef PERL_IMPLICIT_CONTEXT
# ifndef MULTIPLICITY
# define MULTIPLICITY
# endif
# define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL
# define aTHX my_perl
-# define dTHXa(a) pTHX = (PerlInterpreter*)a
-# define dTHX pTHX = PERL_GET_THX
+# ifdef PERL_GLOBAL_STRUCT
+# define dTHXa(a) dVAR; pTHX = (PerlInterpreter*)a
+# else
+# define dTHXa(a) pTHX = (PerlInterpreter*)a
+# endif
+# ifdef PERL_GLOBAL_STRUCT
+# define dTHX dVAR; pTHX = PERL_GET_THX
+# else
+# define dTHX pTHX = PERL_GET_THX
+# endif
# define pTHX_ pTHX,
# define aTHX_ aTHX,
-# define pTHX_1 2
+# define pTHX_1 2
# define pTHX_2 3
# define pTHX_3 4
# define pTHX_4 5
+# define pTHX_5 6
+# define pTHX_6 7
+# define pTHX_7 8
+# define pTHX_8 9
+# define pTHX_9 10
#endif
#define STATIC static
#define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
#define CALLREGFREE CALL_FPTR(PL_regfree)
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
-# define CALLPROTECT CALL_FPTR(PL_protect)
-#endif
-
-#ifdef HASATTRIBUTE
-# if defined(__GNUC__) && defined(__cplusplus)
+#if defined(SYMBIAN) && defined(__GNUC__)
+# ifdef __cplusplus
# define PERL_UNUSED_DECL
# else
# define PERL_UNUSED_DECL __attribute__((unused))
# endif
-#else
-# define PERL_UNUSED_DECL
#endif
+#ifndef PERL_UNUSED_DECL
+# ifdef HASATTRIBUTE_UNUSED
+# define PERL_UNUSED_DECL __attribute__unused__
+# else
+# define PERL_UNUSED_DECL
+# endif
+#endif
+
/* gcc -Wall:
* for silencing unused variables that are actually used most of the time,
* but we cannot quite get rid of, such `ax' in PPCODE+noargs xsubs
*/
-#define PERL_UNUSED_VAR(var) if (0) var = var
+#define PERL_UNUSED_VAR(var) ((void)var)
#define NOOP (void)0
#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
# define pTHX_2 2
# define pTHX_3 3
# define pTHX_4 4
+# define pTHX_5 5
+# define pTHX_6 6
+# define pTHX_7 7
+# define pTHX_8 8
+# define pTHX_9 9
+#endif
+
+#ifndef dVAR
+# define dVAR dNOOP
#endif
/* these are only defined for compatibility; should not be used internally */
* PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...).
* dTHXs is therefore needed for all functions using PerlIO_foo(). */
#ifdef PERL_IMPLICIT_SYS
-# define dTHXs dTHX
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# define dTHXs dVAR; dTHX
+# else
+# define dTHXs dTHX
+# endif
#else
-# define dTHXs dNOOP
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# define dTHXs dVAR
+# else
+# define dTHXs dNOOP
+# endif
#endif
#undef START_EXTERN_C
# define EXTERN_C extern
#endif
+/* Some platforms require marking function declarations
+ * for them to be exportable. Used in perlio.h, proto.h
+ * is handled either by the makedef.pl or by defining the
+ * PERL_CALLCONV to be something special. See also the
+ * definition of XS() in XSUB.h. */
+#ifndef PERL_EXPORT_C
+# define PERL_EXPORT_C extern
+#endif
+#ifndef PERL_XS_EXPORT_C
+# define PERL_XS_EXPORT_C
+#endif
+
#ifdef OP_IN_REGISTER
# ifdef __GNUC__
# define stringify_immed(s) #s
# endif
#endif
+#if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
+# if !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
+#endif
+
/*
* STMT_START { statements; } STMT_END;
* can be used as a single statement, as in
* Trying to select a version that gives no warnings...
*/
#if !(defined(STMT_START) && defined(STMT_END))
-# if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) && !defined(__cplusplus)
+# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
# define STMT_END )
# else
#define DOSISH 1
#endif
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE)
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE) || defined(SYMBIAN)
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE)
+#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
+# undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */
+#endif
+
#if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO)
int syscall(int, ...);
#endif
# define MYSWAP
#endif
+#ifdef PERL_CORE
+
+/* macros for correct constant construction */
+# if INTSIZE >= 2
+# define U16_CONST(x) ((U16)x##U)
+# else
+# define U16_CONST(x) ((U16)x##UL)
+# endif
+
+# if INTSIZE >= 4
+# define U32_CONST(x) ((U32)x##U)
+# else
+# define U32_CONST(x) ((U32)x##UL)
+# endif
+
+# ifdef HAS_QUAD
+# if INTSIZE >= 8
+# define U64_CONST(x) ((U64)x##U)
+# elif LONGSIZE >= 8
+# define U64_CONST(x) ((U64)x##UL)
+# elif QUADKIND == QUAD_IS_LONG_LONG
+# define U64_CONST(x) ((U64)x##ULL)
+# else /* best guess we can make */
+# define U64_CONST(x) ((U64)x##UL)
+# endif
+# endif
+
+/* byte-swapping functions for big-/little-endian conversion */
+# define _swab_16_(x) ((U16)( \
+ (((U16)(x) & U16_CONST(0x00ff)) << 8) | \
+ (((U16)(x) & U16_CONST(0xff00)) >> 8) ))
+
+# define _swab_32_(x) ((U32)( \
+ (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \
+ (((U32)(x) & U32_CONST(0x0000ff00)) << 8) | \
+ (((U32)(x) & U32_CONST(0x00ff0000)) >> 8) | \
+ (((U32)(x) & U32_CONST(0xff000000)) >> 24) ))
+
+# ifdef HAS_QUAD
+# define _swab_64_(x) ((U64)( \
+ (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \
+ (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \
+ (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \
+ (((U64)(x) & U64_CONST(0x00000000ff000000)) << 8) | \
+ (((U64)(x) & U64_CONST(0x000000ff00000000)) >> 8) | \
+ (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \
+ (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \
+ (((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_ARENA_SIZE 4080
+#endif
+
+#endif /* PERL_CORE */
+
/* 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 STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
#endif
-#if defined(I_STRING) || defined(__cplusplus)
-# include <string.h>
-#else
-# include <strings.h>
+#ifndef SYMBIAN
+# if defined(I_STRING) || defined(__cplusplus)
+# include <string.h>
+# else
+# include <strings.h>
+# endif
#endif
/* This comes after <stdlib.h> so we don't try to change the standard
# define MALLOC_CHECK_TAINT(argc,argv,env)
#endif /* MYMALLOC */
-#define TOO_LATE_FOR_(ch,s) Perl_croak(aTHX_ "Too late for \"-%c\" option%s", (char)(ch), s)
+#define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what)
#define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "")
#define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}")
#define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL)
# endif
# endif
# ifdef BUGGY_MSC
- # pragma function(memcmp)
+# pragma function(memcmp)
# endif
#else
# ifndef memcmp
# endif
#endif
+#ifndef PERL_MICRO
#ifndef memchr
# ifndef HAS_MEMCHR
# define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1)
# endif
#endif
+#endif
#ifndef HAS_BCMP
# ifndef bcmp
#endif
/* sockatmark() is so new (2001) that many places might have it hidden
- * behind some -D_BLAH_BLAH_SOURCE guard. */
+ * behind some -D_BLAH_BLAH_SOURCE guard. The __THROW magic is required
+ * e.g. in Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */
#if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO)
+# if defined(__THROW) && defined(__GLIBC__)
+int sockatmark(int) __THROW;
+# else
int sockatmark(int);
+# endif
#endif
#ifdef SETERRNO
# endif
#endif
+#ifndef HAS_QUAD
+# undef PERL_NEED_MY_HTOLE64
+# undef PERL_NEED_MY_LETOH64
+# undef PERL_NEED_MY_HTOBE64
+# undef PERL_NEED_MY_BETOH64
+#endif
+
#if defined(uts) || defined(UTS)
# undef UV_MAX
# define UV_MAX (4294967295u)
# define Perl_atan2 atan2l
# define Perl_pow powl
# define Perl_floor floorl
+# define Perl_ceil ceill
# define Perl_fmod fmodl
# endif
/* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
/* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no
prototype in <math.h> */
# ifndef HAS_MODFL_PROTO
-long double modfl(long double, long double *);
+EXTERN_C long double modfl(long double, long double *);
# endif
# else
# if defined(HAS_AINTL) && defined(HAS_COPYSIGNL)
# define Perl_atan2 atan2
# define Perl_pow pow
# define Perl_floor floor
+# define Perl_ceil ceil
# define Perl_fmod fmod
# define Perl_modf(x,y) modf(x,y)
# define Perl_frexp(x,y) frexp(x,y)
typedef struct block BLOCK;
typedef struct magic MAGIC;
-typedef struct xrv XRV;
typedef struct xpv XPV;
typedef struct xpviv XPVIV;
typedef struct xpvuv XPVUV;
typedef struct ptr_tbl PTR_TBL_t;
typedef struct clone_params CLONE_PARAMS;
-
#include "handy.h"
#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
# define ISHISH "epoc"
#endif
+#ifdef SYMBIAN
+# include "symbian/symbianish.h"
+# include "embed.h"
+# define ISHISH "symbian"
+#endif
+
#if defined(MACOS_TRADITIONAL)
# include "macos/macish.h"
# ifndef NO_ENVIRON_ARRAY
# endif
# define PERL_FPU_INIT fpsetmask(0);
# else
-# if defined(SIGFPE) && defined(SIG_IGN)
+# if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
# define PERL_FPU_INIT PL_sigfpe_saved = signal(SIGFPE, SIG_IGN);
# define PERL_FPU_PRE_EXEC { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
# define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); }
# else
# define PERL_FPU_INIT
+
# endif
# endif
#endif
# include "netware.h"
#endif
+#define STATUS_UNIX PL_statusvalue
#ifdef VMS
# define STATUS_NATIVE PL_statusvalue_vms
# define STATUS_NATIVE_EXPORT \
else \
PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \
} STMT_END
-# define STATUS_POSIX PL_statusvalue
# ifdef VMSISH_STATUS
-# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX)
+# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX)
# else
-# define STATUS_CURRENT STATUS_POSIX
+# define STATUS_CURRENT STATUS_UNIX
# endif
-# define STATUS_POSIX_SET(n) \
+# define STATUS_UNIX_SET(n) \
STMT_START { \
PL_statusvalue = (n); \
if (PL_statusvalue != -1) { \
# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1)
# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44)
#else
-# define STATUS_NATIVE STATUS_POSIX
-# define STATUS_NATIVE_EXPORT STATUS_POSIX
-# define STATUS_NATIVE_SET STATUS_POSIX_SET
-# define STATUS_POSIX PL_statusvalue
-# define STATUS_POSIX_SET(n) \
+# define STATUS_NATIVE PL_statusvalue_posix
+# define STATUS_NATIVE_EXPORT STATUS_NATIVE
+# if defined(WCOREDUMP)
+# define STATUS_NATIVE_SET(n) \
+ STMT_START { \
+ PL_statusvalue_posix = (n); \
+ if (PL_statusvalue_posix == -1) \
+ PL_statusvalue = -1; \
+ else { \
+ PL_statusvalue = \
+ (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \
+ (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0) | \
+ (WIFSIGNALED(PL_statusvalue_posix) && WCOREDUMP(PL_statusvalue_posix) ? 0x80 : 0); \
+ } \
+ } STMT_END
+# elif defined(WIFEXITED)
+# define STATUS_NATIVE_SET(n) \
+ STMT_START { \
+ PL_statusvalue_posix = (n); \
+ if (PL_statusvalue_posix == -1) \
+ PL_statusvalue = -1; \
+ else { \
+ PL_statusvalue = \
+ (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \
+ (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0); \
+ } \
+ } STMT_END
+# else
+# define STATUS_NATIVE_SET(n) \
+ STMT_START { \
+ PL_statusvalue_posix = (n); \
+ if (PL_statusvalue_posix == -1) \
+ PL_statusvalue = -1; \
+ else { \
+ PL_statusvalue = \
+ PL_statusvalue_posix & 0xFFFF; \
+ } \
+ } STMT_END
+# endif
+# 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_CURRENT STATUS_POSIX
-# define STATUS_ALL_SUCCESS (PL_statusvalue = 0)
-# define STATUS_ALL_FAILURE (PL_statusvalue = 1)
+# define STATUS_CURRENT 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
/* flags in PL_exit_flags for nature of exit() */
# define PERL_SET_THX(t) PERL_SET_CONTEXT(t)
#endif
+/* This replaces the previous %_ "hack" by the "%-p" hack
+ All that is required is that the perl source does not
+ use "%-p" or "%-<number>p" format. These format will
+ still work in perl code. RMB 2005/05/17
+*/
#ifndef SVf
-# ifdef CHECK_FORMAT
-# define SVf "p"
-# ifndef SVf256
-# define SVf256 SVf
-# endif
-# else
-# define SVf "_"
-# endif
+# define SVf "-p"
#endif
-#ifndef SVf256
-# define SVf256 ".256"SVf
+#ifndef SVf_precision
+# define SVf_precision(n) "-" n "p"
+#endif
+
+#ifndef SVf32
+# define SVf32 SVf_precision("32")
#endif
+#ifndef SVf256
+# define SVf256 SVf_precision("256")
+#endif
+
#ifndef UVf
-# ifdef CHECK_FORMAT
-# define UVf UVuf
-# else
-# define UVf "Vu"
-# endif
+# define UVf UVuf
#endif
-#ifndef VDf
-# ifdef CHECK_FORMAT
-# define VDf "p"
-# else
-# define VDf "vd"
-# endif
+#ifndef DieNull
+# define DieNull Perl_vdie(aTHX_ Nullch, Null(va_list *))
#endif
-#ifndef Nullformat
-# ifdef CHECK_FORMAT
-# define Nullformat "%s",""
-# else
-# define Nullformat Nullch
+/* In case Configure was not used (we are using a "canned config"
+ * such as Win32, or a cross-compilation setup, for example) try going
+ * by the gcc major and minor versions. One useful URL is
+ * http://www.ohse.de/uwe/articles/gcc-attributes.html,
+ * but contrary to this information warn_unused_result seems
+ * not to be in gcc 3.3.5, at least. --jhi */
+#if defined __GNUC__
+# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
+# define HASATTRIBUTE_FORMAT
+# endif
+# if __GNUC__ >= 3 /* 3.0 -> */
+# define HASATTRIBUTE_MALLOC
# endif
+# if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */
+# define HASATTRIBUTE_NONNULL
+# endif
+# if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */
+# define HASATTRIBUTE_NORETURN
+# endif
+# if __GNUC__ >= 3 /* gcc 3.0 -> */
+# define HASATTRIBUTE_PURE
+# endif
+# if __GNUC__ >= 3 /* gcc 3.0 -> */ /* XXX Verify this version */
+# define HASATTRIBUTE_UNUSED
+# endif
+# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
+# define HASATTRIBUTE_WARN_UNUSED_RESULT
+# endif
+#endif
+
+
+#ifdef HASATTRIBUTE_FORMAT
+# define __attribute__format__(x,y,z) __attribute__((format(x,y,z)))
+#endif
+#ifdef HASATTRIBUTE_MALLOC
+# define __attribute__malloc__ __attribute__((malloc))
+#endif
+#ifdef HASATTRIBUTE_NONNULL
+# define __attribute__nonnull__(a) __attribute__((nonnull(a)))
+#endif
+#ifdef HASATTRIBUTE_NORETURN
+# define __attribute__noreturn__ __attribute__((noreturn))
+#endif
+#ifdef HASATTRIBUTE_PURE
+# define __attribute__pure__ __attribute__((pure))
+#endif
+#ifdef HASATTRIBUTE_UNUSED
+# define __attribute__unused__ __attribute__((unused))
+#endif
+#ifdef HASATTRIBUTE_WARN_UNUSED_RESULT
+# define __attribute__warn_unused_result__ __attribute__((warn_unused_result))
#endif
+/* If we haven't defined the attributes yet, define them to blank. */
#ifndef __attribute__format__
-# ifdef CHECK_FORMAT
-# define __attribute__format__(x,y,z) __attribute__((__format__(x,y,z)))
-# else
-# define __attribute__format__(x,y,z)
-# endif
+# define __attribute__format__(x,y,z)
#endif
-
+#ifndef __attribute__malloc__
+# define __attribute__malloc__
+#endif
+#ifndef __attribute__nonnull__
+# define __attribute__nonnull__(a)
+#endif
+#ifndef __attribute__noreturn__
+# define __attribute__noreturn__
+#endif
+#ifndef __attribute__pure__
+# define __attribute__pure__
+#endif
+#ifndef __attribute__unused__
+# define __attribute__unused__
+#endif
+#ifndef __attribute__warn_unused_result__
+# define __attribute__warn_unused_result__
+#endif
+
+/* For functions that are marked as __attribute__noreturn__, it's not
+ appropriate to call return. In either case, include the lint directive.
+ */
+#ifdef HASATTRIBUTE_NORETURN
+# define NORETURN_FUNCTION_END /* NOT REACHED */
+#else
+# define NORETURN_FUNCTION_END /* NOT REACHED */ return 0
+#endif
+
/* Some unistd.h's give a prototype for pause() even though
HAS_PAUSE ends up undefined. This causes the #define
below to be rejected by the compiler. Sigh.
#endif
#ifndef __cplusplus
-#ifndef UNDER_CE
+#if !(defined(UNDER_CE) || defined(SYMBIAN))
Uid_t getuid (void);
Uid_t geteuid (void);
Gid_t getgid (void);
#define DEBUG_r_FLAG 0x00000200 /* 512 */
#define DEBUG_x_FLAG 0x00000400 /* 1024 */
#define DEBUG_u_FLAG 0x00000800 /* 2048 */
+ /* spare */
#define DEBUG_H_FLAG 0x00002000 /* 8192 */
#define DEBUG_X_FLAG 0x00004000 /* 16384 */
#define DEBUG_D_FLAG 0x00008000 /* 32768 */
#define DEBUG_J_FLAG 0x00080000 /* 524288 */
#define DEBUG_v_FLAG 0x00100000 /*1048576 */
#define DEBUG_C_FLAG 0x00200000 /*2097152 */
-#define DEBUG_MASK 0x003FEFFF /* mask of all the standard flags */
+#define DEBUG_A_FLAG 0x00400000 /*4194304 */
+#define DEBUG_q_FLAG 0x00800000 /*8388608 */
+#define DEBUG_MASK 0x00FFEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
# define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
# define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG)
# define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG)
+# define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG)
+# define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
# define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
#ifdef DEBUGGING
-# undef YYDEBUG
-# define YYDEBUG 1
-
# define DEBUG_p_TEST DEBUG_p_TEST_
# define DEBUG_s_TEST DEBUG_s_TEST_
# define DEBUG_l_TEST DEBUG_l_TEST_
# define DEBUG_J_TEST DEBUG_J_TEST_
# define DEBUG_v_TEST DEBUG_v_TEST_
# define DEBUG_C_TEST DEBUG_C_TEST_
+# define DEBUG_A_TEST DEBUG_A_TEST_
+# define DEBUG_q_TEST DEBUG_q_TEST_
-# define DEB(a) a
-# define DEBUG(a) if (PL_debug) a
+# define PERL_DEB(a) a
+# define PERL_DEBUG(a) if (PL_debug) a
# define DEBUG_p(a) if (DEBUG_p_TEST) a
# define DEBUG_s(a) if (DEBUG_s_TEST) a
# define DEBUG_l(a) if (DEBUG_l_TEST) a
# define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
# define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a)
# define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a)
+# define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a)
+# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
#else /* DEBUGGING */
# define DEBUG_J_TEST (0)
# define DEBUG_v_TEST (0)
# define DEBUG_C_TEST (0)
+# define DEBUG_A_TEST (0)
+# define DEBUG_q_TEST (0)
-# define DEB(a)
-# define DEBUG(a)
+# define PERL_DEB(a)
+# define PERL_DEBUG(a)
# define DEBUG_p(a)
# define DEBUG_s(a)
# define DEBUG_l(a)
# define DEBUG_R(a)
# define DEBUG_v(a)
# define DEBUG_C(a)
+# define DEBUG_A(a)
+# define DEBUG_q(a)
#endif /* DEBUGGING */
#define PERL_MAGIC_arylen '#' /* Array length ($#ary) */
#define PERL_MAGIC_pos '.' /* pos() lvalue */
#define PERL_MAGIC_backref '<' /* for weak ref data */
+#define PERL_MAGIC_symtab ':' /* extra data for symbol tables */
+#define PERL_MAGIC_rhash '%' /* extra data for restricted hashes */
+#define PERL_MAGIC_arylen_p '@' /* to move arylen out of XPVAV */
#define PERL_MAGIC_ext '~' /* Available for use by extensions */
-#define YYMAXDEPTH 300
-
#ifndef assert /* <assert.h> might have been included somehow */
-#ifdef DEBUGGING
-#define assert(what) DEB( { \
- if (!(what)) { \
- Perl_croak(aTHX_ "Assertion " STRINGIFY(what) " failed: file \"%s\", line %d", \
- __FILE__, __LINE__); \
- PerlProc_exit(1); \
- }})
-#else
-#define assert(what) DEB( { \
- if (!(what)) { \
- Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d", \
- __FILE__, __LINE__); \
- PerlProc_exit(1); \
- }})
-#endif
+#define assert(what) PERL_DEB( \
+ ((what) ? ((void) 0) : \
+ (Perl_croak(aTHX_ "Assertion %s failed: file \"" __FILE__ \
+ "\", line %d", STRINGIFY(what), __LINE__), \
+ PerlProc_exit(1), \
+ (void) 0)))
#endif
struct ufuncs {
/* NeXT has problems with crt0.o globals */
#if defined(__DYNAMIC__) && \
- (defined(NeXT) || defined(__NeXT__) || defined(DARWIN))
+ (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN))
# if defined(NeXT) || defined(__NeXT)
# include <mach-o/dyld.h>
# define environ (*environ_pointer)
EXT char *** environ_pointer;
# else
-# if defined(DARWIN) && defined(PERL_CORE)
+# if defined(PERL_DARWIN) && defined(PERL_CORE)
# include <crt_externs.h> /* for the env array */
# define environ (*_NSGetEnviron())
# endif
/* handy constants */
EXTCONST char PL_warn_uninit[]
- INIT("Use of uninitialized value%s%s");
+ INIT("Use of uninitialized value%s%s%s");
EXTCONST char PL_warn_nosemi[]
INIT("Semicolon seems to be missing");
EXTCONST char PL_warn_reserved[]
INIT("Can't use %s ref as %s ref");
EXTCONST char PL_no_symref[]
INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
+EXTCONST char PL_no_symref_sv[]
+ INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use");
EXTCONST char PL_no_usym[]
INIT("Can't use an undefined value as %s reference");
EXTCONST char PL_no_aelem[]
INIT("Modification of non-creatable array value attempted, subscript %d");
-EXTCONST char PL_no_helem[]
- INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
+EXTCONST char PL_no_helem_sv[]
+ 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[]
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[\\]^_");
#ifdef DOINIT
-EXT char *PL_sig_name[] = { SIG_NAME };
-EXT int PL_sig_num[] = { SIG_NUM };
+EXTCONST char* const PL_sig_name[] = { SIG_NAME };
+EXTCONST int PL_sig_num[] = { SIG_NUM };
#else
-EXT char *PL_sig_name[];
-EXT int PL_sig_num[];
+EXTCONST char* const PL_sig_name[];
+EXTCONST int PL_sig_num[];
#endif
/* fast conversion and case folding tables */
#ifdef DOINIT
#ifdef EBCDIC
-EXT unsigned char PL_fold[] = { /* fast EBCDIC case folding table */
+EXTCONST unsigned char PL_fold[] = { /* fast EBCDIC case folding table */
0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23,
EXTCONST unsigned char PL_fold[];
#endif
+#ifndef PERL_GLOBAL_STRUCT /* or perlvars.h */
#ifdef DOINIT
-EXT unsigned char PL_fold_locale[] = {
+EXT unsigned char PL_fold_locale[] = { /* Unfortunately not EXTCONST. */
0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23,
248, 249, 250, 251, 252, 253, 254, 255
};
#else
-EXT unsigned char PL_fold_locale[];
+EXT unsigned char PL_fold_locale[]; /* Unfortunately not EXTCONST. */
#endif
+#endif /* !PERL_GLOBAL_STRUCT */
#ifdef DOINIT
#ifdef EBCDIC
-EXT unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */
+EXTCONST unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */
1, 2, 84, 151, 154, 155, 156, 157,
165, 246, 250, 3, 158, 7, 18, 29,
40, 51, 62, 73, 85, 96, 107, 118,
#ifdef DEBUGGING
#ifdef DOINIT
-EXTCONST char* PL_block_type[] = {
+EXTCONST char* const PL_block_type[] = {
"NULL",
"SUB",
"EVAL",
/*****************************************************************************/
/* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
+#ifdef __Lynx__
+/* LynxOS defines these in scsi.h which is included via ioctl.h */
+#ifdef FORMAT
+#undef FORMAT
+#endif
+#ifdef SPACE
+#undef SPACE
+#endif
+#endif
+
+/* Win32 defines a type 'WORD' in windef.h. This conflicts with the enumerator
+ * 'WORD' defined in perly.h. The yytokentype enum is only a debugging aid, so
+ * it's not really needed.
+ */
+#if defined(WIN32)
+# define YYTOKENTYPE
+#endif
#include "perly.h"
#define LEX_NOTPARSING 11 /* borrowed from toke.c */
want_vtbl_regdata,
want_vtbl_regdatum,
want_vtbl_backref,
- want_vtbl_utf8
+ want_vtbl_utf8,
+ want_vtbl_symtab
};
/* Note: the lowest 8 bits are reserved for
};
#define PERL_DEBUG_PAD(i) &(PL_debug_pad.pad[i])
-#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, SvCUR(PERL_DEBUG_PAD(i)) = 0, PERL_DEBUG_PAD(i))
+#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, \
+ (((XPV*) SvANY(PERL_DEBUG_PAD(i)))->xpv_cur = 0), \
+ PERL_DEBUG_PAD(i))
/* Enable variables which are pointers to functions */
typedef void (CPERLscope(*peep_t))(pTHX_ OP* o);
#define PERLVARA(var,n,type) type var[n];
#define PERLVARI(var,type,init) type var;
#define PERLVARIC(var,type,init) type var;
+#define PERLVARISC(var,init) const char var[sizeof(init)];
+
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
+typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
/* Interpreter exitlist entry */
typedef struct exitlistentry {
void *ptr;
} PerlExitListEntry;
+/* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */
+/* These have to be before perlvars.h */
+#if !defined(HAS_SIGACTION) && defined(VMS)
+# define FAKE_PERSISTENT_SIGNAL_HANDLERS
+#endif
+/* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */
+#if defined(KILL_BY_SIGPRC)
+# define FAKE_DEFAULT_SIGNAL_HANDLERS
+#endif
+
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars {
# include "perlvars.h"
};
# ifdef PERL_CORE
+# ifndef PERL_GLOBAL_STRUCT_PRIVATE
EXT struct perl_vars PL_Vars;
EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
+# undef PERL_GET_VARS
+# define PERL_GET_VARS() PL_VarsPtr
+# endif /* !PERL_GLOBAL_STRUCT_PRIVATE */
# else /* PERL_CORE */
# if !defined(__GNUC__) || !defined(WIN32)
EXT
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+#undef PERLVARISC
-/* Types used by pack/unpack */
-typedef enum {
- e_no_len, /* no length */
- e_number, /* number, [] */
- e_star /* asterisk */
-} howlen_t;
-
-typedef struct {
- char* patptr; /* current template char */
- char* patend; /* one after last char */
- char* grpbeg; /* 1st char of ()-group */
- char* grpend; /* end of ()-group */
- I32 code; /* template code (!) */
- I32 length; /* length/repeat count */
- howlen_t howlen; /* how length is given */
- int level; /* () nesting level */
- U32 flags; /* /=4, comma=2, pack=1 */
-} tempsym_t;
+struct tempsym; /* defined in pp_pack.c */
#include "thread.h"
#include "pp.h"
#ifndef PERL_CALLCONV
# define PERL_CALLCONV
#endif
-
-#ifndef NEXT30_NO_ATTRIBUTE
-# ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */
-# ifdef __attribute__ /* Avoid possible redefinition errors */
-# undef __attribute__
-# endif
-# define __attribute__(attr)
-# endif
-#endif
-
#undef PERL_CKDEF
#undef PERL_PPDEF
-#define PERL_CKDEF(s) OP *s (pTHX_ OP *o);
-#define PERL_PPDEF(s) OP *s (pTHX);
+#define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o);
+#define PERL_PPDEF(s) PERL_CALLCONV OP *s (pTHX);
#include "proto.h"
#define PERLVARA(var,n,type) EXT type PL_##var[n];
#define PERLVARI(var,type,init) EXT type PL_##var INIT(init);
#define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
+#define PERLVARISC(var,init) EXTCONST char PL_##var[sizeof(init)] INIT(init);
#if !defined(MULTIPLICITY)
START_EXTERN_C
START_EXTERN_C
#ifdef DOINIT
-
-EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get),
- MEMBER_TO_FPTR(Perl_magic_set),
- MEMBER_TO_FPTR(Perl_magic_len),
- 0, 0};
-EXT MGVTBL PL_vtbl_env = {0, MEMBER_TO_FPTR(Perl_magic_set_all_env),
- 0, MEMBER_TO_FPTR(Perl_magic_clear_all_env),
- 0};
-EXT MGVTBL PL_vtbl_envelem = {0, MEMBER_TO_FPTR(Perl_magic_setenv),
- 0, MEMBER_TO_FPTR(Perl_magic_clearenv),
- 0};
-EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0};
-#ifdef PERL_MICRO
-EXT MGVTBL PL_vtbl_sigelem = {0, 0, 0, 0, 0};
+# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {a,b,c,d,e,f,g}
#else
-EXT MGVTBL PL_vtbl_sigelem = {MEMBER_TO_FPTR(Perl_magic_getsig),
- MEMBER_TO_FPTR(Perl_magic_setsig),
- 0, MEMBER_TO_FPTR(Perl_magic_clearsig),
- 0};
-#endif
-EXT MGVTBL PL_vtbl_pack = {0, 0,
- MEMBER_TO_FPTR(Perl_magic_sizepack),
- MEMBER_TO_FPTR(Perl_magic_wipepack),
- 0};
-EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack),
- MEMBER_TO_FPTR(Perl_magic_setpack),
- 0, MEMBER_TO_FPTR(Perl_magic_clearpack),
- 0};
-EXT MGVTBL PL_vtbl_dbline = {0, MEMBER_TO_FPTR(Perl_magic_setdbline),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_isa = {0, MEMBER_TO_FPTR(Perl_magic_setisa),
- 0, MEMBER_TO_FPTR(Perl_magic_setisa),
- 0};
-EXT MGVTBL PL_vtbl_isaelem = {0, MEMBER_TO_FPTR(Perl_magic_setisa),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_arylen = {MEMBER_TO_FPTR(Perl_magic_getarylen),
- MEMBER_TO_FPTR(Perl_magic_setarylen),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_glob = {MEMBER_TO_FPTR(Perl_magic_getglob),
- MEMBER_TO_FPTR(Perl_magic_setglob),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_mglob = {0, MEMBER_TO_FPTR(Perl_magic_setmglob),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_nkeys = {MEMBER_TO_FPTR(Perl_magic_getnkeys),
- MEMBER_TO_FPTR(Perl_magic_setnkeys),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint),
- MEMBER_TO_FPTR(Perl_magic_settaint),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr),
- MEMBER_TO_FPTR(Perl_magic_setsubstr),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_vec = {MEMBER_TO_FPTR(Perl_magic_getvec),
- MEMBER_TO_FPTR(Perl_magic_setvec),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_pos = {MEMBER_TO_FPTR(Perl_magic_getpos),
- MEMBER_TO_FPTR(Perl_magic_setpos),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_bm = {0, MEMBER_TO_FPTR(Perl_magic_setbm),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar),
- MEMBER_TO_FPTR(Perl_magic_setuvar),
- 0, 0, 0};
-EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),
- MEMBER_TO_FPTR(Perl_magic_setdefelem),
- 0, 0, 0};
-
-EXT MGVTBL PL_vtbl_regexp = {0, MEMBER_TO_FPTR(Perl_magic_setregexp),0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
-EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0};
-EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get),
- MEMBER_TO_FPTR(Perl_magic_regdatum_set), 0, 0, 0};
+# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
+#endif
+
+MGVTBL_SET(
+ PL_vtbl_sv,
+ MEMBER_TO_FPTR(Perl_magic_get),
+ MEMBER_TO_FPTR(Perl_magic_set),
+ MEMBER_TO_FPTR(Perl_magic_len),
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_env,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_set_all_env),
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_clear_all_env),
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_envelem,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setenv),
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_clearenv),
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_sig,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
-#ifdef USE_LOCALE_COLLATE
-EXT MGVTBL PL_vtbl_collxfrm = {0,
- MEMBER_TO_FPTR(Perl_magic_setcollxfrm),
- 0, 0, 0};
-#endif
-
-EXT MGVTBL PL_vtbl_amagic = {0, MEMBER_TO_FPTR(Perl_magic_setamagic),
- 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)};
-EXT MGVTBL PL_vtbl_amagicelem = {0, MEMBER_TO_FPTR(Perl_magic_setamagic),
- 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)};
-
-EXT MGVTBL PL_vtbl_backref = {0, 0,
- 0, 0, MEMBER_TO_FPTR(Perl_magic_killbackrefs)};
-
-EXT MGVTBL PL_vtbl_ovrld = {0, 0,
- 0, 0, MEMBER_TO_FPTR(Perl_magic_freeovrld)};
-
-EXT MGVTBL PL_vtbl_utf8 = {0,
- MEMBER_TO_FPTR(Perl_magic_setutf8),
- 0, 0, 0};
-
-#else /* !DOINIT */
-
-EXT MGVTBL PL_vtbl_sv;
-EXT MGVTBL PL_vtbl_env;
-EXT MGVTBL PL_vtbl_envelem;
-EXT MGVTBL PL_vtbl_sig;
-EXT MGVTBL PL_vtbl_sigelem;
-EXT MGVTBL PL_vtbl_pack;
-EXT MGVTBL PL_vtbl_packelem;
-EXT MGVTBL PL_vtbl_dbline;
-EXT MGVTBL PL_vtbl_isa;
-EXT MGVTBL PL_vtbl_isaelem;
-EXT MGVTBL PL_vtbl_arylen;
-EXT MGVTBL PL_vtbl_glob;
-EXT MGVTBL PL_vtbl_mglob;
-EXT MGVTBL PL_vtbl_nkeys;
-EXT MGVTBL PL_vtbl_taint;
-EXT MGVTBL PL_vtbl_substr;
-EXT MGVTBL PL_vtbl_vec;
-EXT MGVTBL PL_vtbl_pos;
-EXT MGVTBL PL_vtbl_bm;
-EXT MGVTBL PL_vtbl_fm;
-EXT MGVTBL PL_vtbl_uvar;
-EXT MGVTBL PL_vtbl_ovrld;
-
-EXT MGVTBL PL_vtbl_defelem;
-EXT MGVTBL PL_vtbl_regexp;
-EXT MGVTBL PL_vtbl_regdata;
-EXT MGVTBL PL_vtbl_regdatum;
+#ifdef PERL_MICRO
+MGVTBL_SET(
+ PL_vtbl_sigelem,
+ NULL, NULL, NULL, NULL, NULL, NULL, NULL
+);
+#else
+MGVTBL_SET(
+ PL_vtbl_sigelem,
+ MEMBER_TO_FPTR(Perl_magic_getsig),
+ MEMBER_TO_FPTR(Perl_magic_setsig),
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_clearsig),
+ NULL,
+ NULL,
+ NULL
+);
+#endif
+
+MGVTBL_SET(
+ PL_vtbl_pack,
+ NULL,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_sizepack),
+ MEMBER_TO_FPTR(Perl_magic_wipepack),
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_packelem,
+ MEMBER_TO_FPTR(Perl_magic_getpack),
+ MEMBER_TO_FPTR(Perl_magic_setpack),
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_clearpack),
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_dbline,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setdbline),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_isa,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setisa),
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setisa),
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_isaelem,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setisa),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_arylen,
+ MEMBER_TO_FPTR(Perl_magic_getarylen),
+ MEMBER_TO_FPTR(Perl_magic_setarylen),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_glob,
+ MEMBER_TO_FPTR(Perl_magic_getglob),
+ MEMBER_TO_FPTR(Perl_magic_setglob),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_mglob,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setmglob),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_nkeys,
+ MEMBER_TO_FPTR(Perl_magic_getnkeys),
+ MEMBER_TO_FPTR(Perl_magic_setnkeys),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_taint,
+ MEMBER_TO_FPTR(Perl_magic_gettaint),
+ MEMBER_TO_FPTR(Perl_magic_settaint),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_substr,
+ MEMBER_TO_FPTR(Perl_magic_getsubstr),
+ MEMBER_TO_FPTR(Perl_magic_setsubstr),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_vec,
+ MEMBER_TO_FPTR(Perl_magic_getvec),
+ MEMBER_TO_FPTR(Perl_magic_setvec),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_pos,
+ MEMBER_TO_FPTR(Perl_magic_getpos),
+ MEMBER_TO_FPTR(Perl_magic_setpos),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_bm,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setbm),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_fm,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setfm),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_uvar,
+ MEMBER_TO_FPTR(Perl_magic_getuvar),
+ MEMBER_TO_FPTR(Perl_magic_setuvar),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_defelem,
+ MEMBER_TO_FPTR(Perl_magic_getdefelem),
+ MEMBER_TO_FPTR(Perl_magic_setdefelem),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_regexp,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setregexp),
+ NULL,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_freeregexp),
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_regdata,
+ NULL,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_regdata_cnt),
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_regdatum,
+ MEMBER_TO_FPTR(Perl_magic_regdatum_get),
+ MEMBER_TO_FPTR(Perl_magic_regdatum_set),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_amagic,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setamagic),
+ NULL,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setamagic),
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_amagicelem,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setamagic),
+ NULL,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setamagic),
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_backref,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_killbackrefs),
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_ovrld,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_freeovrld),
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
+ PL_vtbl_utf8,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setutf8),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
#ifdef USE_LOCALE_COLLATE
-EXT MGVTBL PL_vtbl_collxfrm;
+MGVTBL_SET(
+ PL_vtbl_collxfrm,
+ NULL,
+ MEMBER_TO_FPTR(Perl_magic_setcollxfrm),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
#endif
-EXT MGVTBL PL_vtbl_amagic;
-EXT MGVTBL PL_vtbl_amagicelem;
-
-EXT MGVTBL PL_vtbl_backref;
-EXT MGVTBL PL_vtbl_utf8;
-
-#endif /* !DOINIT */
enum {
fallback_amg, abs_amg,
};
#define NofAMmeth max_amg_code
-#define AMG_id2name(id) ((char*)PL_AMG_names[id]+1)
+#define AMG_id2name(id) (PL_AMG_names[id]+1)
#ifdef DOINIT
-EXTCONST char * PL_AMG_names[NofAMmeth] = {
+EXTCONST char * const PL_AMG_names[NofAMmeth] = {
/* Names kept in the symbol table. fallback => "()", the rest has
"(" prepended. The only other place in perl which knows about
this convention is AMG_id2name (used for debugging output and
#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
#define IN_LOCALE \
- (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+ (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
bool was_local = PL_numeric_local && IN_LOCALE; \
#if !defined(Strtoul) && defined(HAS_STRTOUL)
# define Strtoul strtoul
#endif
+#if !defined(Strtoul) && defined(HAS_STRTOL) /* Last resort. */
+# define Strtoul(s, e, b) strchr((s), '-') ? ULONG_MAX : (unsigned long)strtol((s), (e), (b))
+#endif
#ifndef Atoul
# define Atoul(s) Strtoul(s, (char **)NULL, 10)
#endif
new_chunk_size = (chunk_size); \
if (new_chunk_size > PL_nice_chunk_size) { \
if (PL_nice_chunk) Safefree(PL_nice_chunk); \
- PL_nice_chunk = new_chunk; \
+ PL_nice_chunk = (char *) new_chunk; \
PL_nice_chunk_size = new_chunk_size; \
} else { \
Safefree(chunk); \
Zero(my_cxtp, 1, my_cxt_t); \
sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+
/* This macro must be used to access members of the my_cxt_t structure.
* e.g. MYCXT.some_data */
#define MY_CXT (*my_cxtp)
#define dMY_CXT_SV dNOOP
#define dMY_CXT dNOOP
#define MY_CXT_INIT NOOP
+#define MY_CXT_CLONE NOOP
#define MY_CXT my_cxt
#define pMY_CXT void
# include <fcntl.h>
#endif
+#ifdef __Lynx__
+# include <fcntl.h>
+#endif
+
#ifdef I_SYS_FILE
# include <sys/file.h>
#endif
# define PERL_MOUNT_NOSUID M_NOSUID
#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(MOUNT_NOEXEC)
+# define PERL_MOUNT_NOEXEC MOUNT_NOEXEC
+#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(MNT_NOEXEC)
+# define PERL_MOUNT_NOEXEC MNT_NOEXEC
+#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(MS_NOEXEC)
+# define PERL_MOUNT_NOEXEC MS_NOEXEC
+#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(M_NOEXEC)
+# define PERL_MOUNT_NOEXEC M_NOEXEC
+#endif
+
#endif /* IAMSUID */
#ifdef I_LIBUTIL
# define PIPESOCK_MODE
#endif
+#ifndef SOCKET_OPEN_MODE
+# define SOCKET_OPEN_MODE PIPESOCK_MODE
+#endif
+
+#ifndef PIPE_OPEN_MODE
+# define PIPE_OPEN_MODE PIPESOCK_MODE
+#endif
+
#define PERL_MAGIC_UTF8_CACHESIZE 2
#define PERL_UNICODE_STDIN_FLAG 0x0001
* but also beware since this evaluates its argument twice, so no x++. */
#define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
+#if defined(__DECC) && defined(__osf__)
+#pragma message disable (mainparm) /* Perl uses the envp in main(). */
+#endif
+
/* and finally... */
#define PERL_PATCHLEVEL_H_IMPLICIT
#include "patchlevel.h"
https://perl5.git.perl.org / perl5.git / blobdiff