/* perl.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 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.
#ifdef PERL_MICRO
# include "uconfig.h"
#else
-# include "config.h"
+# ifndef USE_CROSS_COMPILE
+# include "config.h"
+# else
+# include "xconfig.h"
+# endif
#endif
/* See L<perlguts/"The Perl API"> for detailed notes on
# endif
#endif
-#if defined(MULTIPLICITY)
-# ifndef PERL_IMPLICIT_CONTEXT
-# define PERL_IMPLICIT_CONTEXT
-# 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
+#ifdef MULTIPLICITY
+# ifndef PERL_IMPLICIT_CONTEXT
+# define PERL_IMPLICIT_CONTEXT
+# endif
+#endif
+
/* undef WIN32 when building on Cygwin (for libwin32) - gph */
#ifdef __CYGWIN__
# undef WIN32
# 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. *
# ifndef MULTIPLICITY
# define MULTIPLICITY
# endif
-# define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL
+# define tTHX PerlInterpreter*
+# define pTHX register tTHX my_perl PERL_UNUSED_DECL
# define aTHX my_perl
# ifdef PERL_GLOBAL_STRUCT
-# define dTHXa(a) dVAR; pTHX = (PerlInterpreter*)a
+# define dTHXa(a) dVAR; pTHX = (tTHX)a
# else
-# define dTHXa(a) pTHX = (PerlInterpreter*)a
+# define dTHXa(a) pTHX = (tTHX)a
# endif
# ifdef PERL_GLOBAL_STRUCT
# define dTHX dVAR; pTHX = PERL_GET_THX
# define pTHX_7 8
# define pTHX_8 9
# define pTHX_9 10
+# if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL)
+# define PERL_TRACK_MEMPOOL
+# endif
+#else
+# undef PERL_TRACK_MEMPOOL
#endif
#define STATIC static
#define CALL_FPTR(fptr) (*fptr)
#define CALLRUNOPS CALL_FPTR(PL_runops)
-#define CALLREGCOMP CALL_FPTR(PL_regcompp)
-#define CALLREGEXEC CALL_FPTR(PL_regexecp)
-#define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start)
-#define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
-#define CALLREGFREE CALL_FPTR(PL_regfree)
-#if defined(SYMBIAN) && defined(__GNUC__)
+#define CALLREGCOMP(sv, flags) Perl_pregcomp(aTHX_ (sv),(flags))
+
+#define CALLREGCOMP_ENG(prog, sv, flags) \
+ CALL_FPTR(((prog)->comp))(aTHX_ sv, flags)
+#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \
+ CALL_FPTR((prog)->engine->exec)(aTHX_ (prog),(stringarg),(strend), \
+ (strbeg),(minend),(screamer),(data),(flags))
+#define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \
+ CALL_FPTR((prog)->engine->intuit)(aTHX_ (prog), (sv), (strpos), \
+ (strend),(flags),(data))
+#define CALLREG_INTUIT_STRING(prog) \
+ CALL_FPTR((prog)->engine->checkstr)(aTHX_ (prog))
+
+#define CALLREG_AS_STR(mg,lp,flags,haseval) \
+ Perl_reg_stringify(aTHX_ (mg), (lp), (flags), (haseval))
+#define CALLREG_STRINGIFY(mg,lp,flags) CALLREG_AS_STR(mg,lp,flags,0)
+
+#define CALLREGFREE(prog) \
+ Perl_pregfree(aTHX_ (prog))
+
+#define CALLREGFREE_PVT(prog) \
+ if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog))
+
+#define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \
+ CALL_FPTR((rx)->engine->numbered_buff_FETCH)(aTHX_ (rx),(paren),(usesv))
+
+#define CALLREG_NUMBUF_STORE(rx,paren,value) \
+ CALL_FPTR((rx)->engine->numbered_buff_STORE)(aTHX_ (rx),(paren),(value))
+
+#define CALLREG_NUMBUF_LENGTH(rx,sv,paren) \
+ CALL_FPTR((rx)->engine->numbered_buff_LENGTH)(aTHX_ (rx),(sv),(paren))
+
+#define CALLREG_NAMED_BUFF_FETCH(rx, key, flags) \
+ CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH))
+
+#define CALLREG_NAMED_BUFF_STORE(rx, key, value, flags) \
+ CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE))
+
+#define CALLREG_NAMED_BUFF_DELETE(rx, key, flags) \
+ CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE))
+
+#define CALLREG_NAMED_BUFF_CLEAR(rx, flags) \
+ CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR))
+
+#define CALLREG_NAMED_BUFF_EXISTS(rx, key, flags) \
+ CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS))
+
+#define CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags) \
+ CALL_FPTR((rx)->engine->named_buff_iter)(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY))
+
+#define CALLREG_NAMED_BUFF_NEXTKEY(rx, lastkey, flags) \
+ CALL_FPTR((rx)->engine->named_buff_iter)(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY))
+
+#define CALLREG_NAMED_BUFF_SCALAR(rx, flags) \
+ CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR))
+
+#define CALLREG_NAMED_BUFF_COUNT(rx) \
+ CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT)
+
+#define CALLREG_NAMED_BUFF_ALL(rx, flags) \
+ CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), NULL, NULL, flags)
+
+#define CALLREG_PACKAGE(rx) \
+ CALL_FPTR((rx)->engine->qr_package)(aTHX_ (rx))
+
+#if defined(USE_ITHREADS)
+#define CALLREGDUPE(prog,param) \
+ Perl_re_dup(aTHX_ (prog),(param))
+
+#define CALLREGDUPE_PVT(prog,param) \
+ (prog ? CALL_FPTR((prog)->engine->dupe)(aTHX_ (prog),(param)) \
+ : (REGEXP *)NULL)
+#endif
+
+
+
+
+
+/*
+ * Because of backward compatibility reasons the PERL_UNUSED_DECL
+ * cannot be changed from postfix to PERL_UNUSED_DECL(x). Sigh.
+ *
+ * Note that there are C compilers such as MetroWerks CodeWarrior
+ * which do not have an "inlined" way (like the gcc __attribute__) of
+ * marking unused variables (they need e.g. a #pragma) and therefore
+ * cpp macros like PERL_UNUSED_DECL cannot work for this purpose, even
+ * if it were PERL_UNUSED_DECL(x), which it cannot be (see above).
+ *
+ */
+
+#if defined(__SYMBIAN32__) && defined(__GNUC__)
# ifdef __cplusplus
# define PERL_UNUSED_DECL
# else
#endif
#ifndef PERL_UNUSED_DECL
-# ifdef HASATTRIBUTE_UNUSED
+# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
# define PERL_UNUSED_DECL __attribute__unused__
# else
# define PERL_UNUSED_DECL
* but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs
*/
#ifndef PERL_UNUSED_ARG
-# ifdef lint
+# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
# include <note.h>
# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
# else
# define PERL_UNUSED_VAR(x) ((void)x)
#endif
-#define NOOP (void)0
-#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#ifdef USE_ITHREADS
+# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
+#else
+# define PERL_UNUSED_CONTEXT
+#endif
+
+#define NOOP /*EMPTY*/(void)0
+#if !defined(HASATTRIBUTE_UNUSED) && defined(__cplusplus)
+#define dNOOP /*EMPTY*/(void)0 /* Older g++ has no __attribute((unused))__ */
+#else
+#define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
+#endif
#ifndef pTHX
+/* Don't bother defining tTHX and sTHX; using them outside
+ * code guarded by PERL_IMPLICIT_CONTEXT is an error.
+ */
# define pTHX void
# define pTHX_
# define aTHX
* PERL_CALLCONV to be something special. See also the
* definition of XS() in XSUB.h. */
#ifndef PERL_EXPORT_C
-# define PERL_EXPORT_C extern
+# ifdef __cplusplus
+# define PERL_EXPORT_C extern "C"
+# else
+# define PERL_EXPORT_C extern
+# endif
#endif
#ifndef PERL_XS_EXPORT_C
-# define PERL_XS_EXPORT_C
+# ifdef __cplusplus
+# define PERL_XS_EXPORT_C extern "C"
+# else
+# define PERL_XS_EXPORT_C
+# endif
#endif
#ifdef OP_IN_REGISTER
# endif
#endif
-#if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
-# if !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+/* gcc (-ansi) -pedantic doesn't allow gcc statement expressions,
+ * g++ allows them but seems to have problems with them
+ * (insane errors ensue). */
+#if defined(PERL_GCC_PEDANTIC) || (defined(__GNUC__) && defined(__cplusplus))
+# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
# endif
#endif
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+# ifndef PERL_USE_GCC_BRACE_GROUPS
+# define PERL_USE_GCC_BRACE_GROUPS
+# 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(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+# ifdef PERL_USE_GCC_BRACE_GROUPS
# define STMT_START (void)( /* gcc supports "({ STATEMENTS; })" */
# define STMT_END )
# else
#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
#define WITH_THR(s) WITH_THX(s)
-/*
- * SOFT_CAST can be used for args to prototyped functions to retain some
- * type checking; it only casts if the compiler does not know prototypes.
- */
-#if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE)
-#define SOFT_CAST(type)
-#else
-#define SOFT_CAST(type) (type)
-#endif
-
#ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */
# define BYTEORDER 0x1234
#endif
#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
#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(Nullch, s); }
+#define TAINT_PROPER(s) if (PL_tainting) { taint_proper(NULL, s); }
/* XXX All process group stuff is handled in pp_sys.c. Should these
defines move there? If so, I could simplify this a lot. --AD 9/96.
# include <unistd.h>
#endif
-#ifdef SYMBIAN
+#ifdef __SYMBIAN32__
# 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, ...);
+EXTERN_C int syscall(int, ...);
#endif
#if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO) && !defined(PERL_MICRO)
-int usleep(unsigned int);
+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 */
/* We no longer default to creating a new SV for GvSV.
Do this before embed. */
#ifndef PERL_CREATE_GVSV
-#define PERL_DONT_CREATE_GVSV
+# ifndef PERL_DONT_CREATE_GVSV
+# define PERL_DONT_CREATE_GVSV
+# endif
+#endif
+
+#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
+#define PERL_USES_PL_PIDSTATUS
+#endif
+
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL)
+#define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
#endif
/* Cannot include embed.h here on Win32 as win32.h has not
*/
#if !defined(PERL_FOR_X2P) && !(defined(WIN32)||defined(VMS))
# include "embed.h"
+# ifndef PERL_MAD
+# undef op_getmad
+# define op_getmad(arg,pegop,slot) NOOP
+# endif
#endif
#define MEM_SIZE Size_t
# 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
# endif
#endif
+#if defined(__osf__) && defined(__cplusplus) && !defined(_XOPEN_SOURCE_EXTENDED) /* Tru64 "cxx" (C++), see hints/dec_osf.sh for why the _XOPEN_SOURCE_EXTENDED cannot be defined. */
+EXTERN_C int fchdir(int);
+EXTERN_C int flock(int, int);
+EXTERN_C int fseeko(FILE *, off_t, int);
+EXTERN_C off_t ftello(FILE *);
+#endif
+
+#if defined(__SUNPRO_CC) /* SUNWspro CC (C++) */
+EXTERN_C char *crypt(const char *, const char *);
+EXTERN_C char **environ;
+#endif
+
+#if defined(__cplusplus)
+# if defined(__OpenBSD__) || defined(__FreeBSD__) || defined(__NetBSD__)
+EXTERN_C char **environ;
+# elif defined(__CYGWIN__)
+EXTERN_C char *crypt(const char *, const char *);
+#endif
+#endif
+
#ifdef SETERRNO
# undef SETERRNO /* SOCKS might have defined this */
#endif
# 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
+
+/*
+ * If we have v?snprintf() and the C99 variadic macros, we can just
+ * use just the v?snprintf(). It is nice to try to trap the buffer
+ * overflow, however, so if we are DEBUGGING, and we cannot use the
+ * gcc statement expressions, then use the function wrappers which try
+ * to trap the overflow. If we can use the gcc statement expressions,
+ * we can try that even with the version that uses the C99 variadic
+ * macros.
+ */
+
+/* Note that we do not check against snprintf()/vsnprintf() returning
+ * negative values because that is non-standard behaviour and we use
+ * snprintf/vsnprintf only iff HAS_VSNPRINTF has been defined, and
+ * that should be true only if the snprintf()/vsnprintf() are true
+ * to the standard. */
+
+#if defined(HAS_SNPRINTF) && 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_snprintf(buffer, len, ...) ({ int __len__ = snprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: snprintf buffer overflow"); __len__; })
+# define PERL_MY_SNPRINTF_GUARDED
+# else
+# define my_snprintf(buffer, len, ...) snprintf(buffer, len, __VA_ARGS__)
+# endif
+#else
+# define my_snprintf Perl_my_snprintf
+# define PERL_MY_SNPRINTF_GUARDED
+#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 PERL_MY_VSNPRINTF_GUARDED
+# else
+# define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__)
+# endif
+#else
+# define my_vsnprintf Perl_my_vsnprintf
+# define PERL_MY_VSNPRINTF_GUARDED
+#endif
+
+#ifdef HAS_STRLCAT
+# define my_strlcat strlcat
+#else
+# define my_strlcat Perl_my_strlcat
+#endif
+
+#ifdef HAS_STRLCPY
+# define my_strlcpy strlcpy
+#else
+# define my_strlcpy Perl_my_strlcpy
+#endif
+
/* Configure gets this right but the UTS compiler gets it wrong.
-- Hal Morris <hom00@utsglobal.com> */
#ifdef UTS
#else
# if PTRSIZE == LONGSIZE
# define PTRV unsigned long
+# define PTR2ul(p) (unsigned long)(p)
# else
# define PTRV unsigned
# endif
+#endif
+
+#ifndef INT2PTR
# define INT2PTR(any,d) (any)(PTRV)(d)
#endif
+
+#ifndef PTR2ul
+# define PTR2ul(p) INT2PTR(unsigned long,p)
+#endif
+
#define NUM2PTR(any,d) (any)(PTRV)(d)
#define PTR2IV(p) INT2PTR(IV,p)
#define PTR2UV(p) INT2PTR(UV,p)
#define PTR2NV(p) NUM2PTR(NV,p)
-#if PTRSIZE == LONGSIZE
-# define PTR2ul(p) (unsigned long)(p)
-#else
-# define PTR2ul(p) INT2PTR(unsigned long,p)
-#endif
+#define PTR2nat(p) (PTRV)(p) /* pointer to integer of PTRSIZE */
/* According to strict ANSI C89 one cannot freely cast between
* data pointers and function (code) pointers. There are at least
* The only feasible use is probably temporarily storing
* function pointers in a data pointer (such as a void pointer). */
-#define DPTR2FPTR(t,p) ((t)(PTRV)(p)) /* data pointer to function pointer */
-#define FPTR2DPTR(t,p) ((t)(PTRV)(p)) /* function pointer to data pointer */
+#define DPTR2FPTR(t,p) ((t)PTR2nat(p)) /* data pointer to function pointer */
+#define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */
#ifdef USE_LONG_DOUBLE
# if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
#define DBL_DIG 15 /* A guess that works lots of places */
#endif
#endif
-#ifdef I_FLOAT
-#include <float.h>
-#endif
-#ifndef HAS_DBL_DIG
-#define DBL_DIG 15 /* A guess that works lots of places */
-#endif
#ifdef OVR_LDBL_DIG
/* Use an overridden LDBL_DIG */
#endif
struct RExC_state_t;
+struct _reg_trie_data;
typedef MEM_SIZE STRLEN;
+#ifdef PERL_MAD
+typedef struct token TOKEN;
+typedef struct madprop MADPROP;
+typedef struct nexttoken NEXTTOKE;
+#endif
typedef struct op OP;
typedef struct cop COP;
typedef struct unop UNOP;
#if defined(VMS)
# include "vmsish.h"
# include "embed.h"
+# ifndef PERL_MAD
+# undef op_getmad
+# define op_getmad(arg,pegop,slot) NOOP
+# endif
# define ISHISH "vms"
#endif
# define ISHISH "epoc"
#endif
-#ifdef SYMBIAN
+#ifdef __SYMBIAN32__
# include "symbian/symbianish.h"
# include "embed.h"
+# ifndef PERL_MAD
+# undef op_getmad
+# define op_getmad(arg,pegop,slot) NOOP
+# endif
# define ISHISH "symbian"
#endif
# define ISHISH "unix"
#endif
+/* NSIG logic from Configure --> */
+/* Strange style to avoid deeply-nested #if/#else/#endif */
+#ifndef NSIG
+# ifdef _NSIG
+# define NSIG (_NSIG)
+# endif
+#endif
+
+#ifndef NSIG
+# ifdef SIGMAX
+# define NSIG (SIGMAX+1)
+# endif
+#endif
+
+#ifndef NSIG
+# ifdef SIG_MAX
+# define NSIG (SIG_MAX+1)
+# endif
+#endif
+
+#ifndef NSIG
+# ifdef _SIG_MAX
+# define NSIG (_SIG_MAX+1)
+# endif
+#endif
+
+#ifndef NSIG
+# ifdef MAXSIG
+# define NSIG (MAXSIG+1)
+# endif
+#endif
+
+#ifndef NSIG
+# ifdef MAX_SIG
+# define NSIG (MAX_SIG+1)
+# endif
+#endif
+
+#ifndef NSIG
+# ifdef SIGARRAYSIZE
+# define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */
+# endif
+#endif
+
+#ifndef NSIG
+# ifdef _sys_nsig
+# define NSIG (_sys_nsig) /* Solaris 2.5 */
+# endif
+#endif
+
+/* Default to some arbitrary number that's big enough to get most
+ of the common signals.
+*/
+#ifndef NSIG
+# define NSIG 50
+#endif
+/* <-- NSIG logic from Configure */
+
#ifndef NO_ENVIRON_ARRAY
# define USE_ENVIRON_ARRAY
#endif
# if HAS_FLOATINGPOINT_H
# include <floatingpoint.h>
# endif
-# define PERL_FPU_INIT fpsetmask(0);
+# define PERL_FPU_INIT fpsetmask(0)
# else
# if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
-# define PERL_FPU_INIT PL_sigfpe_saved = signal(SIGFPE, SIG_IGN);
+# define PERL_FPU_INIT PL_sigfpe_saved = (Sighandler_t) 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_POST_EXEC }
#endif
-#ifndef PERL_SYS_INIT3
-# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
+#ifndef PERL_SYS_INIT3_BODY
+# define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp)
#endif
+#define PERL_SYS_INIT(argc, argv) Perl_sys_init(argc, argv)
+#define PERL_SYS_INIT3(argc, argv, env) Perl_sys_init3(argc, argv, env)
+#define PERL_SYS_TERM() Perl_sys_term()
+
#ifndef PERL_WRITE_MSG_TO_CONSOLE
# define PERL_WRITE_MSG_TO_CONSOLE(io, msg, len) PerlIO_write(io, msg, len)
#endif
* 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
+ * Also, when building extensions with an installed perl, this allows
+ * the user to upgrade gcc and get the right attributes, rather than
+ * relying on the list generated at Configure time. --AD
* Set these up now otherwise we get confused when some of the <*thread.h>
* includes below indirectly pull in <perlio.h> (which needs to know if we
* have HASATTRIBUTE_FORMAT).
*/
-#if defined __GNUC__
+#if defined __GNUC__ && !defined(__INTEL_COMPILER)
# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
# define HASATTRIBUTE_FORMAT
+# if defined __MINGW32__
+# define PRINTF_FORMAT_NULL_OK
+# endif
# endif
# if __GNUC__ >= 3 /* 3.0 -> */
# define HASATTRIBUTE_MALLOC
# if __GNUC__ >= 3 /* gcc 3.0 -> */
# define HASATTRIBUTE_PURE
# endif
-# if __GNUC__ >= 3 /* gcc 3.0 -> */ /* XXX Verify this version */
+# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
# define HASATTRIBUTE_UNUSED
# endif
+# if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus)
+# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */
+# endif
# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
# define HASATTRIBUTE_WARN_UNUSED_RESULT
# endif
#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
+ * its 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; \
+ if (MY_POSIX_EXIT) \
+ PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\
+ else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \
+ } \
+ else { \
+ PL_statusvalue_vms = vaxc$errno; \
+ } \
} \
- else PL_statusvalue_vms = -1; \
+ else PL_statusvalue_vms = SS$_ABORT; \
+ set_vaxc_errno(PL_statusvalue_vms); \
+ } STMT_END
+
+ /* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets
+ * the NATIVE error status based on it. It does not assume that
+ * the UNIX/POSIX exit codes have any relationship to errno, except
+ * that 0 indicates a success. When in the default mode to comply
+ * with the Perl VMS documentation, any other code sets the NATIVE
+ * status to a failure code of SS$_ABORT.
+ *
+ * In the new POSIX EXIT mode, native status will be set so that the
+ * actual exit code will can be retrieved by the calling program or
+ * shell.
+ *
+ * If the exit code is not clearly a UNIX parent or child exit status,
+ * it will be passed through as a VMS status.
+ */
+
+# define STATUS_UNIX_EXIT_SET(n) \
+ 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) : 1); \
+ else \
+ PL_statusvalue_vms = SS$_ABORT; \
+ } else { /* forgive them Perl, for they have sinned */ \
+ if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \
+ else PL_statusvalue_vms = vaxc$errno; \
+ /* And obviously used a VMS status value instead of UNIX */ \
+ PL_statusvalue = EVMSERR; \
+ } \
+ } \
+ else PL_statusvalue_vms = SS$_ABORT; \
+ set_vaxc_errno(PL_statusvalue_vms); \
} STMT_END
-# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1)
-# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44)
+
+ /* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code
+ * and sets the NATIVE error status based on it. This special case
+ * is needed to maintain compatibility with past VMS behavior.
+ *
+ * In the default mode on VMS, this number is passed through as
+ * both the NATIVE and UNIX status. Which makes it different
+ * that the STATUS_UNIX_EXIT_SET.
+ *
+ * In the new POSIX EXIT mode, native status will be set so that the
+ * actual exit code will can be retrieved by the calling program or
+ * shell.
+ *
+ */
+
+# define STATUS_EXIT_SET(n) \
+ STMT_START { \
+ I32 evalue = (I32)n; \
+ PL_statusvalue = evalue; \
+ if (MY_POSIX_EXIT) \
+ PL_statusvalue_vms = \
+ (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
+ (STS$K_ERROR | STS$M_INHIB_MSG) : 1); \
+ else \
+ PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \
+ set_vaxc_errno(PL_statusvalue_vms); \
+ } STMT_END
+
+
+ /* This macro forces a success status */
+# define STATUS_ALL_SUCCESS \
+ (PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL)
+
+ /* This macro forces a failure status */
+# define STATUS_ALL_FAILURE (PL_statusvalue = 1, \
+ vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \
+ (C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT)
+
#else
# define STATUS_NATIVE PL_statusvalue_posix
-# 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_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
# define PERL_SET_THX(t) PERL_SET_CONTEXT(t)
#endif
-/* This replaces the previous %_ "hack" by the "%-p" hack
+/*
+ This replaces the previous %_ "hack" by the "%p" hacks.
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
+ use "%-p" or "%-<number>p" or "%<number>p" formats.
+ These formats will still work in perl code.
+ See comments in sv.c for futher details.
+
+ Robin Barker 2005-07-14
+
+ No longer use %1p for VDf = %vd. RMB 2007-10-19
*/
-#ifndef SVf
-# define SVf "-p"
+
+#ifndef SVf_
+# define SVf_(n) "-" STRINGIFY(n) "p"
#endif
-#ifndef SVf_precision
-# define SVf_precision(n) "-" n "p"
+#ifndef SVf
+# define SVf "-p"
#endif
#ifndef SVf32
-# define SVf32 SVf_precision("32")
+# define SVf32 SVf_(32)
#endif
#ifndef SVf256
-# define SVf256 SVf_precision("256")
+# define SVf256 SVf_(256)
#endif
-
-#ifndef UVf
-# define UVf UVuf
+
+#define SVfARG(p) ((void*)(p))
+
+#ifdef PERL_CORE
+/* not used; but needed for backward compatibilty with XS code? - RMB */
+# undef VDf
+#else
+# ifndef VDf
+# define VDf "vd"
+# endif
#endif
-#ifndef DieNull
-# define DieNull Perl_vdie(aTHX_ Nullch, Null(va_list *))
+#ifdef PERL_CORE
+/* not used; but needed for backward compatibilty with XS code? - RMB */
+# undef UVf
+#else
+# ifndef UVf
+# define UVf UVuf
+# endif
#endif
#ifdef HASATTRIBUTE_FORMAT
appropriate to call return. In either case, include the lint directive.
*/
#ifdef HASATTRIBUTE_NORETURN
-# define NORETURN_FUNCTION_END /* NOT REACHED */
+# define NORETURN_FUNCTION_END /* NOTREACHED */
+#else
+# define NORETURN_FUNCTION_END /* NOTREACHED */ return 0
+#endif
+
+/* Some OS warn on NULL format to printf */
+#ifdef PRINTF_FORMAT_NULL_OK
+# define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z)
+#else
+# define __attribute__format__null_ok__(x,y,z)
+#endif
+
+#ifdef HAS_BUILTIN_EXPECT
+# define EXPECT(expr,val) __builtin_expect(expr,val)
#else
-# define NORETURN_FUNCTION_END /* NOT REACHED */ return 0
+# define EXPECT(expr,val) (expr)
+#endif
+#define LIKELY(cond) EXPECT(cond,1)
+#define UNLIKELY(cond) EXPECT(cond,0)
+#ifdef HAS_BUILTIN_CHOOSE_EXPR
+/* placeholder */
#endif
/* Some unistd.h's give a prototype for pause() even though
#ifndef IOCPARM_LEN
# ifdef IOCPARM_MASK
- /* on BSDish systes we're safe */
+ /* on BSDish systems we're safe */
# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK)
# else
+# if defined(_IOC_SIZE) && defined(__GLIBC__)
+ /* on Linux systems we're safe; except when we're not [perl #38223] */
+# define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x))
+# else
/* otherwise guess at what's safe */
-# define IOCPARM_LEN(x) 256
+# define IOCPARM_LEN(x) 256
+# endif
# endif
#endif
typedef I32 (*filter_t) (pTHX_ int, SV *, int);
#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len)
-#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx])
-#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters))
+#define FILTER_DATA(idx) \
+ (PL_parser ? AvARRAY(PL_parser->rsfp_filters)[idx] : NULL)
+#define FILTER_ISREADER(idx) \
+ (PL_parser && PL_parser->rsfp_filters \
+ && idx >= AvFILLp(PL_parser->rsfp_filters))
+#define PERL_FILTER_EXISTS(i) \
+ (PL_parser && PL_parser->rsfp_filters \
+ && (i) <= av_len(PL_parser->rsfp_filters))
#if defined(_AIX) && !defined(_AIX43)
#if defined(USE_REENTRANT) || defined(_REENTRANT) || defined(_THREAD_SAFE)
# include "iperlsys.h"
#endif
+#ifdef __LIBCATAMOUNT__
+#undef HAS_PASSWD /* unixish.h but not unixish enough. */
+#undef HAS_GROUP
+#define FAKE_BIT_BUCKET
+#endif
+
/* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0.
* Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT*
* defined by Configure, despite their names being similar to the
# define USE_HASH_SEED
#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"
+
+#ifdef PERL_MAD
+struct nexttoken {
+ YYSTYPE next_val; /* value of next token, if any */
+ I32 next_type; /* type of next token */
+ MADPROP *next_mad; /* everything else about that token */
+};
+#endif
+
#include "regexp.h"
#include "sv.h"
#include "util.h"
#include "cv.h"
#include "opnames.h"
#include "op.h"
+#include "hv.h"
#include "cop.h"
#include "av.h"
-#include "hv.h"
#include "mg.h"
#include "scope.h"
#include "warnings.h"
#include "utf8.h"
-/* Current curly descriptor */
-typedef struct curcur CURCUR;
-struct curcur {
- int parenfloor; /* how far back to strip paren data */
- int cur; /* how many instances of scan we've matched */
- int min; /* the minimal number of scans to match */
- int max; /* the maximal number of scans to match */
- int minmod; /* whether to work our way up or down */
- regnode * scan; /* the thing to match */
- regnode * next; /* what has to match after it */
- char * lastloc; /* where we started matching this scan */
- CURCUR * oldcc; /* current curly before we started this one */
-};
typedef struct _sublex_info SUBLEXINFO;
struct _sublex_info {
- I32 super_state; /* lexer state to save */
- I32 sub_inwhat; /* "lex_inwhat" to use */
+ U8 super_state; /* lexer state to save */
+ U16 sub_inwhat; /* "lex_inwhat" to use */
OP *sub_op; /* "lex_op" to use */
- char *super_bufptr; /* PL_bufptr that was */
- char *super_bufend; /* PL_bufend that was */
+ char *super_bufptr; /* PL_parser->bufptr that was */
+ char *super_bufend; /* PL_parser->bufend that was */
};
+#include "parser.h"
+
typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
struct scan_data_t; /* Used in S_* functions in regcomp.c */
struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */
-typedef I32 CHECKPOINT;
-
/* Keep next first in this structure, because sv_free_arenas take
advantage of this to share code between the pte arenas and the SV
body arenas */
#define U_I(what) ((unsigned int)U_32(what))
#define U_L(what) U_32(what)
+#ifdef HAS_SIGNBIT
+# define Perl_signbit signbit
+#endif
+
/* These do not care about the fractional part, only about the range. */
#define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX)
#define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX)
#define DEBUG_r_FLAG 0x00000200 /* 512 */
#define DEBUG_x_FLAG 0x00000400 /* 1024 */
#define DEBUG_u_FLAG 0x00000800 /* 2048 */
- /* spare */
+/* U is reserved for Unofficial, exploratory hacking */
+#define DEBUG_U_FLAG 0x00001000 /* 4096 */
#define DEBUG_H_FLAG 0x00002000 /* 8192 */
#define DEBUG_X_FLAG 0x00004000 /* 16384 */
#define DEBUG_D_FLAG 0x00008000 /* 32768 */
# define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG)
# define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG)
# define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG)
+# define DEBUG_U_TEST_ (PL_debug & DEBUG_U_FLAG)
# define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG)
# define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG)
# define DEBUG_D_TEST_ (PL_debug & DEBUG_D_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_)
+# define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_)
#ifdef DEBUGGING
# define DEBUG_r_TEST DEBUG_r_TEST_
# define DEBUG_x_TEST DEBUG_x_TEST_
# define DEBUG_u_TEST DEBUG_u_TEST_
+# define DEBUG_U_TEST DEBUG_U_TEST_
# define DEBUG_H_TEST DEBUG_H_TEST_
# define DEBUG_X_TEST DEBUG_X_TEST_
-# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
# define DEBUG_D_TEST DEBUG_D_TEST_
# define DEBUG_S_TEST DEBUG_S_TEST_
# define DEBUG_T_TEST DEBUG_T_TEST_
# define DEBUG_C_TEST DEBUG_C_TEST_
# define DEBUG_A_TEST DEBUG_A_TEST_
# define DEBUG_q_TEST DEBUG_q_TEST_
+# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
+# define DEBUG_Uv_TEST DEBUG_Uv_TEST_
# define PERL_DEB(a) a
# define PERL_DEBUG(a) if (PL_debug) a
} STMT_END
# define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
+#ifndef PERL_EXT_RE_BUILD
# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
+#else
+# define DEBUG_r(a) STMT_START {a;} STMT_END
+#endif /* PERL_EXT_RE_BUILD */
# define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
# define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
+# define DEBUG_U(a) DEBUG__(DEBUG_U_TEST, a)
# define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
# define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a)
-# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
# define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a)
+# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
+# define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a)
# define DEBUG_S(a)
# define DEBUG_r_TEST (0)
# define DEBUG_x_TEST (0)
# define DEBUG_u_TEST (0)
+# define DEBUG_U_TEST (0)
# define DEBUG_H_TEST (0)
# define DEBUG_X_TEST (0)
-# define DEBUG_Xv_TEST (0)
# define DEBUG_D_TEST (0)
# define DEBUG_S_TEST (0)
# define DEBUG_T_TEST (0)
# define DEBUG_C_TEST (0)
# define DEBUG_A_TEST (0)
# define DEBUG_q_TEST (0)
+# define DEBUG_Xv_TEST (0)
+# define DEBUG_Uv_TEST (0)
# define PERL_DEB(a)
# define PERL_DEBUG(a)
# define DEBUG_r(a)
# define DEBUG_x(a)
# define DEBUG_u(a)
+# define DEBUG_U(a)
# define DEBUG_H(a)
# define DEBUG_X(a)
-# define DEBUG_Xv(a)
# define DEBUG_D(a)
# define DEBUG_S(a)
# define DEBUG_T(a)
# define DEBUG_C(a)
# define DEBUG_A(a)
# define DEBUG_q(a)
+# define DEBUG_Xv(a)
+# define DEBUG_Uv(a)
#endif /* DEBUGGING */
#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__)));
#define PERL_MAGIC_envelem 'e' /* %ENV hash element */
#define PERL_MAGIC_fm 'f' /* Formline ('compiled' format) */
#define PERL_MAGIC_regex_global 'g' /* m//g target / study()ed string */
+#define PERL_MAGIC_hints 'H' /* %^H hash */
+#define PERL_MAGIC_hintselem 'h' /* %^H hash element */
#define PERL_MAGIC_isa 'I' /* @ISA array */
#define PERL_MAGIC_isaelem 'i' /* @ISA array element */
#define PERL_MAGIC_nkeys 'k' /* scalar(keys()) lvalue */
#define PERL_MAGIC_dbfile 'L' /* Debugger %_<filename */
#define PERL_MAGIC_dbline 'l' /* Debugger %_<filename element */
-#define PERL_MAGIC_mutex 'm' /* for lock op */
#define PERL_MAGIC_shared 'N' /* Shared between threads */
#define PERL_MAGIC_shared_scalar 'n' /* Shared between threads */
#define PERL_MAGIC_collxfrm 'o' /* Locale transformation */
#define PERL_MAGIC_substr 'x' /* substr() lvalue */
#define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable /
smart parameter vivification */
-#define PERL_MAGIC_glob '*' /* GV (typeglob) */
#define PERL_MAGIC_arylen '#' /* Array length ($#ary) */
#define PERL_MAGIC_pos '.' /* pos() lvalue */
#define PERL_MAGIC_backref '<' /* for weak ref data */
#ifndef assert /* <assert.h> might have been included somehow */
#define assert(what) PERL_DEB( \
((what) ? ((void) 0) : \
- (Perl_croak(aTHX_ "Assertion %s failed: file \"" __FILE__ \
+ (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \
"\", line %d", STRINGIFY(what), __LINE__), \
- PerlProc_exit(1), \
(void) 0)))
#endif
#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 (pTHX_ const char*);
#else
#define UNLINK PerlLIO_unlink
#endif
# define RUNOPS_DEFAULT Perl_runops_standard
#endif
+#ifdef USE_PERLIO
+EXTERN_C void PerlIO_teardown();
+# ifdef USE_ITHREADS
+# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex)
+# define PERLIO_TERM \
+ STMT_START { \
+ PerlIO_teardown(); \
+ MUTEX_DESTROY(&PL_perlio_mutex);\
+ } STMT_END
+# else
+# define PERLIO_INIT
+# define PERLIO_TERM PerlIO_teardown()
+# endif
+#else
+# define PERLIO_INIT
+# define PERLIO_TERM
+#endif
+
#ifdef MYMALLOC
# ifdef MUTEX_INIT_CALLS_MALLOC
# define MALLOC_INIT \
# define MALLOC_TERM
#endif
+#if defined(PERL_IMPLICIT_CONTEXT)
+
+struct perl_memory_debug_header;
+struct perl_memory_debug_header {
+ tTHX interpreter;
+# ifdef PERL_POISON
+ MEM_SIZE size;
+# endif
+ struct perl_memory_debug_header *prev;
+ struct perl_memory_debug_header *next;
+};
+
+# define sTHX (sizeof(struct perl_memory_debug_header) + \
+ (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
+ %MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
+
+#endif
+
+#ifdef PERL_TRACK_MEMPOOL
+# define INIT_TRACK_MEMPOOL(header, interp) \
+ STMT_START { \
+ (header).interpreter = (interp); \
+ (header).prev = (header).next = &(header); \
+ } STMT_END
+# else
+# define INIT_TRACK_MEMPOOL(header, interp)
+#endif
+
typedef int (CPERLscope(*runops_proc_t)) (pTHX);
typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);
typedef int (CPERLscope(*thrhook_proc_t)) (pTHX);
typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
+typedef bool (CPERLscope(*destroyable_proc_t)) (pTHX_ SV *sv);
/* _ (for $_) must be first in the following list (DEFSV requires it) */
#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
EXTCONST char PL_no_aelem[]
INIT("Modification of non-creatable array value attempted, subscript %d");
EXTCONST char PL_no_helem_sv[]
- INIT("Modification of non-creatable hash value attempted, subscript \""SVf"\"");
+ 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_func[]
INIT("The %s function is unimplemented");
EXTCONST char PL_no_myglob[]
- INIT("\"my\" variable %s can't be in a package");
+ INIT("\"%s\" 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");
+
+#ifdef CSH
+EXTCONST char PL_cshname[]
+ INIT(CSH);
+# define PL_cshlen (sizeof(CSH "") - 1)
#endif
EXTCONST char PL_uuemap[65]
INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
-
#ifdef DOINIT
+EXTCONST char PL_uudmap[256] =
+#include "uudmap.h"
+;
EXTCONST char* const PL_sig_name[] = { SIG_NAME };
EXTCONST int PL_sig_num[] = { SIG_NUM };
#else
+EXTCONST char PL_uudmap[256];
EXTCONST char* const PL_sig_name[];
EXTCONST int PL_sig_num[];
#endif
"LOOP",
"SUBST",
"BLOCK",
+ "FORMAT",
+ "GIVEN",
+ "WHEN"
};
#else
EXTCONST char* PL_block_type[];
#endif
#endif
+/* These are all the compile time options that affect binary compatibility.
+ Other compile time options that are binary compatible are in perl.c
+ Both are combined for the output of perl -V
+ However, this string will be embedded in any shared perl library, which will
+ allow us add a comparison check in perlmain.c in the near future. */
+#ifdef DOINIT
+EXTCONST char PL_bincompat_options[] =
+# ifdef DEBUG_LEAKING_SCALARS
+ " DEBUG_LEAKING_SCALARS"
+# endif
+# ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+ " DEBUG_LEAKING_SCALARS_FORK_DUMP"
+# endif
+# ifdef FAKE_THREADS
+ " FAKE_THREADS"
+# endif
+# ifdef MULTIPLICITY
+ " MULTIPLICITY"
+# endif
+# ifdef MYMALLOC
+ " MYMALLOC"
+# endif
+# ifdef PERL_DEBUG_READONLY_OPS
+ " PERL_DEBUG_READONLY_OPS"
+# endif
+# ifdef PERL_GLOBAL_STRUCT
+ " PERL_GLOBAL_STRUCT"
+# endif
+# ifdef PERL_IMPLICIT_CONTEXT
+ " PERL_IMPLICIT_CONTEXT"
+# endif
+# ifdef PERL_IMPLICIT_SYS
+ " PERL_IMPLICIT_SYS"
+# endif
+# ifdef PERL_MAD
+ " PERL_MAD"
+# endif
+# ifdef PERL_NEED_APPCTX
+ " PERL_NEED_APPCTX"
+# endif
+# ifdef PERL_NEED_TIMESBASE
+ " PERL_NEED_TIMESBASE"
+# endif
+# ifdef PERL_OLD_COPY_ON_WRITE
+ " PERL_OLD_COPY_ON_WRITE"
+# endif
+# ifdef PERL_POISON
+ " PERL_POISON"
+# endif
+# ifdef PERL_TRACK_MEMPOOL
+ " PERL_TRACK_MEMPOOL"
+# endif
+# ifdef PERL_USES_PL_PIDSTATUS
+ " PERL_USES_PL_PIDSTATUS"
+# endif
+# ifdef PL_OP_SLAB_ALLOC
+ " PL_OP_SLAB_ALLOC"
+# endif
+# ifdef THREADS_HAVE_PIDS
+ " THREADS_HAVE_PIDS"
+# endif
+# ifdef USE_64_BIT_ALL
+ " USE_64_BIT_ALL"
+# endif
+# ifdef USE_64_BIT_INT
+ " USE_64_BIT_INT"
+# endif
+# ifdef USE_IEEE
+ " USE_IEEE"
+# endif
+# ifdef USE_ITHREADS
+ " USE_ITHREADS"
+# endif
+# ifdef USE_LARGE_FILES
+ " USE_LARGE_FILES"
+# endif
+# ifdef USE_LONG_DOUBLE
+ " USE_LONG_DOUBLE"
+# endif
+# ifdef USE_PERLIO
+ " USE_PERLIO"
+# endif
+# ifdef USE_REENTRANT_API
+ " USE_REENTRANT_API"
+# endif
+# ifdef USE_SFIO
+ " USE_SFIO"
+# endif
+# ifdef USE_SOCKS
+ " USE_SOCKS"
+# endif
+# ifdef VMS_DO_SOCKETS
+ " VMS_DO_SOCKETS"
+# ifdef DECCRTL_SOCKETS
+ " DECCRTL_SOCKETS"
+# endif
+# endif
+# ifdef VMS_WE_ARE_CASE_SENSITIVE
+ " VMS_SYMBOL_CASE_AS_IS"
+# endif
+ "";
+#else
+EXTCONST char PL_bincompat_options[];
+#endif
+
END_EXTERN_C
/*****************************************************************************/
#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 */
typedef enum {
want_vtbl_backref,
want_vtbl_utf8,
want_vtbl_symtab,
- want_vtbl_arylen_p
+ want_vtbl_arylen_p,
+ want_vtbl_hintselem
};
- /* Note: the lowest 8 bits are reserved for
- stuffing into op->op_private */
-#define HINT_PRIVATE_MASK 0x000000ff
+
+/* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer
+ special and there is no need for HINT_PRIVATE_MASK for COPs
+ However, bitops store HINT_INTEGER in their op_private. */
#define HINT_INTEGER 0x00000001 /* integer pragma */
#define HINT_STRICT_REFS 0x00000002 /* strict pragma */
#define HINT_LOCALE 0x00000004 /* locale pragma */
#define HINT_BYTES 0x00000008 /* bytes pragma */
-/* #define HINT_notused10 0x00000010 */
+#define HINT_ARYBASE 0x00000010 /* $[ is non-zero */
/* Note: 20,40,80 used for NATIVE_HINTS */
/* currently defined by vms/vmsish.h */
#define HINT_NEW_STRING 0x00008000
#define HINT_NEW_RE 0x00010000
#define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */
+#define HINT_LEXICAL_IO_IN 0x00040000 /* ${^OPEN} is set for input */
+#define HINT_LEXICAL_IO_OUT 0x00080000 /* ${^OPEN} is set for output */
#define HINT_RE_TAINT 0x00100000 /* re pragma */
#define HINT_RE_EVAL 0x00200000 /* re pragma */
#define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */
#define HINT_UTF8 0x00800000 /* utf8 pragma */
-/* assertions pragma */
-#define HINT_ASSERTING 0x01000000
-#define HINT_ASSERTIONSSEEN 0x02000000
-
-/* The following are stored in $sort::hints, not in PL_hints */
+/* The following are stored in $^H{sort}, not in PL_hints */
#define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */
#define HINT_SORT_QUICKSORT 0x00000001
#define HINT_SORT_MERGESORT 0x00000002
typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv,
char *strpos, char *strend,
U32 flags,
- struct re_scream_pos_data_s *d);
+ re_scream_pos_data *d);
typedef SV* (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog);
typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r);
+typedef regexp*(CPERLscope(*regdupe_t)) (pTHX_ const regexp* r, CLONE_PARAMS *param);
typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*);
typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*);
# define FAKE_DEFAULT_SIGNAL_HANDLERS
#endif
+#define PERL_PATCHLEVEL_H_IMPLICIT
+#include "patchlevel.h"
+#undef PERL_PATCHLEVEL_H_IMPLICIT
+
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars {
# include "perlvars.h"
*/
struct interpreter {
-# include "thrdvar.h"
# include "intrpvar.h"
-/*
- * The following is a buffer where new variables must
- * be defined to maintain binary compatibility with previous versions
- */
-PERLVARA(object_compatibility,30, char)
};
#else
};
#endif /* MULTIPLICITY */
-typedef void *Thread;
-
/* Done with PERLVAR macros for now ... */
#undef PERLVAR
#undef PERLVARA
#include "pp.h"
#ifndef PERL_CALLCONV
-# define PERL_CALLCONV
+# ifdef __cplusplus
+# define PERL_CALLCONV extern "C"
+# else
+# define PERL_CALLCONV
+# endif
#endif
#undef PERL_CKDEF
#undef PERL_PPDEF
#if !defined(PERL_FOR_X2P)
# include "embedvar.h"
#endif
+#ifndef PERL_MAD
+# undef PL_madskills
+# undef PL_xmlfp
+# define PL_madskills 0
+# define PL_xmlfp 0
+#endif
/* Now include all the 'global' variables
* If we don't have threads or multiple interpreters
#if !defined(MULTIPLICITY)
START_EXTERN_C
# include "intrpvar.h"
-# include "thrdvar.h"
END_EXTERN_C
#endif
#if defined(WIN32)
/* Now all the config stuff is setup we can include embed.h */
# include "embed.h"
+# ifndef PERL_MAD
+# undef op_getmad
+# define op_getmad(arg,pegop,slot) NOOP
+# endif
#endif
#ifndef PERL_GLOBAL_STRUCT
START_EXTERN_C
+/* PERL_GLOBAL_STRUCT_PRIVATE wants to keep global data like the
+ * magic vtables const, but this is incompatible with SWIG which
+ * does want to modify the vtables. */
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# define EXT_MGVTBL EXTCONST MGVTBL
+#else
+# define EXT_MGVTBL EXT MGVTBL
+#endif
+
#ifdef DOINIT
-# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {a,b,c,d,e,f,g}
-# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g} /* Like MGVTBL_SET but with the get magic having a const MG* */
+# define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var = {a,b,c,d,e,f,g,h}
+/* Like MGVTBL_SET but with the get magic having a const MG* */
+# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var \
+ = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g,h}
#else
-# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
-# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
+# define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var
+# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var
#endif
+/* These all need to be 0, not NULL, as NULL can be (void*)0, which is a
+ * pointer to data, whereas we're assigning pointers to functions, which are
+ * not the same beast. ANSI doesn't allow the assignment from one to the other.
+ * (although most, but not all, compilers are prepared to do it)
+ */
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
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_env,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_set_all_env),
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_clear_all_env),
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_envelem,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setenv),
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_clearenv),
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0
);
+/* For now, hints magic will also use vtbl_sig, because it is all 0 */
MGVTBL_SET(
PL_vtbl_sig,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
#ifdef PERL_MICRO
MGVTBL_SET(
PL_vtbl_sigelem,
- NULL, NULL, NULL, NULL, NULL, NULL, NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
#else
PL_vtbl_sigelem,
MEMBER_TO_FPTR(Perl_magic_getsig),
MEMBER_TO_FPTR(Perl_magic_setsig),
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_clearsig),
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0
);
#endif
MGVTBL_SET(
PL_vtbl_pack,
- NULL,
- NULL,
+ 0,
+ 0,
MEMBER_TO_FPTR(Perl_magic_sizepack),
MEMBER_TO_FPTR(Perl_magic_wipepack),
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_packelem,
MEMBER_TO_FPTR(Perl_magic_getpack),
MEMBER_TO_FPTR(Perl_magic_setpack),
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_clearpack),
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_dbline,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setdbline),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_isa,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setisa),
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setisa),
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_isaelem,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setisa),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET_CONST_MAGIC_GET(
PL_vtbl_arylen,
MEMBER_TO_FPTR(Perl_magic_getarylen),
MEMBER_TO_FPTR(Perl_magic_setarylen),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_arylen_p,
- NULL,
- NULL,
- NULL,
- NULL,
+ 0,
+ 0,
+ 0,
+ 0,
MEMBER_TO_FPTR(Perl_magic_freearylen_p),
- NULL,
- NULL
-);
-
-MGVTBL_SET(
- PL_vtbl_glob,
- MEMBER_TO_FPTR(Perl_magic_getglob),
- MEMBER_TO_FPTR(Perl_magic_setglob),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_mglob,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setmglob),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_nkeys,
MEMBER_TO_FPTR(Perl_magic_getnkeys),
MEMBER_TO_FPTR(Perl_magic_setnkeys),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_taint,
MEMBER_TO_FPTR(Perl_magic_gettaint),
MEMBER_TO_FPTR(Perl_magic_settaint),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_substr,
MEMBER_TO_FPTR(Perl_magic_getsubstr),
MEMBER_TO_FPTR(Perl_magic_setsubstr),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_vec,
MEMBER_TO_FPTR(Perl_magic_getvec),
MEMBER_TO_FPTR(Perl_magic_setvec),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_pos,
MEMBER_TO_FPTR(Perl_magic_getpos),
MEMBER_TO_FPTR(Perl_magic_setpos),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_bm,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setbm),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_fm,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setfm),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_uvar,
MEMBER_TO_FPTR(Perl_magic_getuvar),
MEMBER_TO_FPTR(Perl_magic_setuvar),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_defelem,
MEMBER_TO_FPTR(Perl_magic_getdefelem),
MEMBER_TO_FPTR(Perl_magic_setdefelem),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_regexp,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setregexp),
- NULL,
- NULL,
+ 0,
+ 0,
MEMBER_TO_FPTR(Perl_magic_freeregexp),
- NULL,
- NULL
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_regdata,
- NULL,
- NULL,
+ 0,
+ 0,
MEMBER_TO_FPTR(Perl_magic_regdata_cnt),
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_regdatum,
MEMBER_TO_FPTR(Perl_magic_regdatum_get),
MEMBER_TO_FPTR(Perl_magic_regdatum_set),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_amagic,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setamagic),
- NULL,
- NULL,
+ 0,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setamagic),
- NULL,
- NULL
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_amagicelem,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setamagic),
- NULL,
- NULL,
+ 0,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setamagic),
- NULL,
- NULL
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_backref,
- NULL,
- NULL,
- NULL,
- NULL,
+ 0,
+ 0,
+ 0,
+ 0,
MEMBER_TO_FPTR(Perl_magic_killbackrefs),
- NULL,
- NULL
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_ovrld,
- NULL,
- NULL,
- NULL,
- NULL,
+ 0,
+ 0,
+ 0,
+ 0,
MEMBER_TO_FPTR(Perl_magic_freeovrld),
- NULL,
- NULL
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_utf8,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setutf8),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
#ifdef USE_LOCALE_COLLATE
MGVTBL_SET(
PL_vtbl_collxfrm,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setcollxfrm),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
#endif
+MGVTBL_SET(
+ PL_vtbl_hintselem,
+ 0,
+ MEMBER_TO_FPTR(Perl_magic_sethint),
+ 0,
+ MEMBER_TO_FPTR(Perl_magic_clearhint),
+ 0,
+ 0,
+ 0,
+ 0
+);
-enum {
- fallback_amg, abs_amg,
- bool__amg, nomethod_amg,
- string_amg, numer_amg,
- add_amg, add_ass_amg,
- subtr_amg, subtr_ass_amg,
- mult_amg, mult_ass_amg,
- div_amg, div_ass_amg,
- modulo_amg, modulo_ass_amg,
- pow_amg, pow_ass_amg,
- lshift_amg, lshift_ass_amg,
- rshift_amg, rshift_ass_amg,
- band_amg, band_ass_amg,
- bor_amg, bor_ass_amg,
- bxor_amg, bxor_ass_amg,
- lt_amg, le_amg,
- gt_amg, ge_amg,
- eq_amg, ne_amg,
- ncmp_amg, scmp_amg,
- slt_amg, sle_amg,
- sgt_amg, sge_amg,
- seq_amg, sne_amg,
- not_amg, compl_amg,
- inc_amg, dec_amg,
- atan2_amg, cos_amg,
- sin_amg, exp_amg,
- log_amg, sqrt_amg,
- repeat_amg, repeat_ass_amg,
- concat_amg, concat_ass_amg,
- copy_amg, neg_amg,
- to_sv_amg, to_av_amg,
- to_hv_amg, to_gv_amg,
- to_cv_amg, iter_amg,
- int_amg, DESTROY_amg,
- max_amg_code
- /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
-};
-
-#define NofAMmeth max_amg_code
-#define AMG_id2name(id) (PL_AMG_names[id]+1)
-
-#ifdef DOINIT
-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
- 'nomethod' only), the only other place which has it hardwired is
- overload.pm. */
- "()", "(abs", /* "fallback" should be the first. */
- "(bool", "(nomethod",
- "(\"\"", "(0+",
- "(+", "(+=",
- "(-", "(-=",
- "(*", "(*=",
- "(/", "(/=",
- "(%", "(%=",
- "(**", "(**=",
- "(<<", "(<<=",
- "(>>", "(>>=",
- "(&", "(&=",
- "(|", "(|=",
- "(^", "(^=",
- "(<", "(<=",
- "(>", "(>=",
- "(==", "(!=",
- "(<=>", "(cmp",
- "(lt", "(le",
- "(gt", "(ge",
- "(eq", "(ne",
- "(!", "(~",
- "(++", "(--",
- "(atan2", "(cos",
- "(sin", "(exp",
- "(log", "(sqrt",
- "(x", "(x=",
- "(.", "(.=",
- "(=", "(neg",
- "(${}", "(@{}",
- "(%{}", "(*{}",
- "(&{}", "(<>",
- "(int", "DESTROY",
-};
-#else
-EXTCONST char * PL_AMG_names[NofAMmeth];
-#endif /* def INITAMAGIC */
+#include "overload.h"
END_EXTERN_C
struct am_table {
+ U32 flags;
U32 was_ok_sub;
long was_ok_am;
- U32 flags;
- CV* table[NofAMmeth];
long fallback;
+ CV* table[NofAMmeth];
};
struct am_table_short {
+ U32 flags;
U32 was_ok_sub;
long was_ok_am;
- U32 flags;
};
typedef struct am_table AMT;
typedef struct am_table_short AMTS;
#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto */
#define PERLDBf_NAMEEVAL 0x100 /* Informative names for evals */
#define PERLDBf_NAMEANON 0x200 /* Informative names for anon subs */
-#define PERLDBf_ASSERTION 0x400 /* Debug assertion subs enter/exit */
#define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB))
#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE))
#define SET_NUMERIC_LOCAL() \
set_numeric_local();
-#define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
+#define IN_LOCALE_RUNTIME (CopHINTS_get(PL_curcop) & HINT_LOCALE)
#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
#define IN_LOCALE \
# 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)
+# define Atoul(s) Strtoul(s, NULL, 10)
#endif
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
- * this, if you want to make the extension thread-safe. See ext/re/re.xs
- * for an example of the use of these macros, and perlxs.pod for more.
+ * this, if you want to make the extension thread-safe. See
+ * ext/XS/APItest/APItest.xs for an example of the use of these macros,
+ * and perlxs.pod for more.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g.
* "DynaLoader::_guts" XS_VERSION
+ * XXX in the current implementation, this string is ignored.
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
#if defined(PERL_IMPLICIT_CONTEXT)
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+
/* This must appear in all extensions that define a my_cxt_t structure,
* right after the definition (i.e. at file scope). The non-threads
* case below uses it to declare the data as static. */
#define START_MY_CXT
+#define MY_CXT_INDEX Perl_my_cxt_index(aTHX_ MY_CXT_KEY)
+
+/* Creates and zeroes the per-interpreter data.
+ * (We allocate my_cxtp in a Perl SV so that it will be released when
+ * the interpreter goes away.) */
+#define MY_CXT_INIT \
+ my_cxt_t *my_cxtp = \
+ (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_KEY, sizeof(my_cxt_t))
+#define MY_CXT_INIT_INTERP(my_perl) \
+ my_cxt_t *my_cxtp = \
+ (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_KEY, sizeof(my_cxt_t))
+
+/* This declaration should be used within all functions that use the
+ * interpreter-local data. */
+#define dMY_CXT \
+ my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[MY_CXT_INDEX]
+#define dMY_CXT_INTERP(my_perl) \
+ my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[MY_CXT_INDEX]
+
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Copy(PL_my_cxt_list[MY_CXT_INDEX], my_cxtp, 1, my_cxt_t);\
+ PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp \
-/* Fetches the SV that keeps the per-interpreter data. */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
- sizeof(MY_CXT_KEY)-1, TRUE)
+#else /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */
+
+/* This must appear in all extensions that define a my_cxt_t structure,
+ * right after the definition (i.e. at file scope). The non-threads
+ * case below uses it to declare the data as static. */
+#define START_MY_CXT static int my_cxt_index = -1;
/* This declaration should be used within all functions that use the
* interpreter-local data. */
#define dMY_CXT \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*, SvUV(my_cxt_sv))
+ my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[my_cxt_index]
+#define dMY_CXT_INTERP(my_perl) \
+ my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[my_cxt_index]
/* Creates and zeroes the per-interpreter data.
* (We allocate my_cxtp in a Perl SV so that it will be released when
* the interpreter goes away.) */
#define MY_CXT_INIT \
- dMY_CXT_SV; \
- /* newSV() allocates one more than needed */ \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Zero(my_cxtp, 1, my_cxt_t); \
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+ my_cxt_t *my_cxtp = \
+ (my_cxt_t*)Perl_my_cxt_init(aTHX_ &my_cxt_index, sizeof(my_cxt_t))
+#define MY_CXT_INIT_INTERP(my_perl) \
+ my_cxt_t *my_cxtp = \
+ (my_cxt_t*)Perl_my_cxt_init(my_perl, &my_cxt_index, sizeof(my_cxt_t))
/* 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))
+ Copy(PL_my_cxt_list[my_cxt_index], my_cxtp, 1, my_cxt_t);\
+ PL_my_cxt_list[my_cxt_index] = my_cxtp \
+
+#endif /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */
/* This macro must be used to access members of the my_cxt_t structure.
* e.g. MYCXT.some_data */
#define aMY_CXT_ aMY_CXT,
#define _aMY_CXT ,aMY_CXT
-#else /* USE_ITHREADS */
+#else /* PERL_IMPLICIT_CONTEXT */
#define START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV dNOOP
#define aMY_CXT_
#define _aMY_CXT
-#endif /* !defined(USE_ITHREADS) */
+#endif /* !defined(PERL_IMPLICIT_CONTEXT) */
#ifdef I_FCNTL
# include <fcntl.h>
#define PERL_UNICODE_ARGV_FLAG 0x0020
#define PERL_UNICODE_LOCALE_FLAG 0x0040
#define PERL_UNICODE_WIDESYSCALLS_FLAG 0x0080 /* for Sarathy */
+#define PERL_UNICODE_UTF8CACHEASSERT_FLAG 0x0100
#define PERL_UNICODE_STD_FLAG \
(PERL_UNICODE_STDIN_FLAG | \
PERL_UNICODE_INOUT_FLAG | \
PERL_UNICODE_LOCALE_FLAG)
-#define PERL_UNICODE_ALL_FLAGS 0x00ff
+#define PERL_UNICODE_ALL_FLAGS 0x01ff
#define PERL_UNICODE_STDIN 'I'
#define PERL_UNICODE_STDOUT 'O'
#define PERL_UNICODE_ARGV 'A'
#define PERL_UNICODE_LOCALE 'L'
#define PERL_UNICODE_WIDESYSCALLS 'W'
+#define PERL_UNICODE_UTF8CACHEASSERT 'a'
#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
#pragma message disable (mainparm) /* Perl uses the envp in main(). */
#endif
-/* and finally... */
-#define PERL_PATCHLEVEL_H_IMPLICIT
-#include "patchlevel.h"
-#undef PERL_PATCHLEVEL_H_IMPLICIT
+#define do_open(g, n, l, a, rm, rp, sf) \
+ do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0)
+#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
+# define do_exec(cmd) do_exec3(cmd,0,0)
+#endif
+#ifdef OS2
+# define do_aexec Perl_do_aexec
+#else
+# define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0)
+#endif
+
+#if defined(OEMVS)
+#define NO_ENV_ARRAY_IN_MAIN
+#endif
+
+/* These are used by Perl_pv_escape() and Perl_pv_pretty()
+ * are here so that they are available throughout the core
+ * NOTE that even though some are for _escape and some for _pretty
+ * there must not be any clashes as the flags from _pretty are
+ * passed straight through to _escape.
+ */
+
+#define PERL_PV_ESCAPE_QUOTE 0x0001
+#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
+
+#define PERL_PV_PRETTY_ELLIPSES 0x0002
+#define PERL_PV_PRETTY_LTGT 0x0004
-/* Mention
+#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
+
+#define PERL_PV_ESCAPE_UNI 0x0100
+#define PERL_PV_ESCAPE_UNI_DETECT 0x0200
+
+#define PERL_PV_ESCAPE_ALL 0x1000
+#define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
+#define PERL_PV_ESCAPE_NOCLEAR 0x4000
+#define PERL_PV_ESCAPE_RE 0x8000
+
+#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
+
+/* used by pv_display in dump.c*/
+#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
+#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
+
+/*
+
+ (KEEP THIS LAST IN perl.h!)
+
+ Mention
NV_PRESERVES_UV
HAS_DIRFD
- so that Configure picks them up. */
+ so that Configure picks them up.
-#endif /* Include guard */
+ (KEEP THIS LAST IN perl.h!)
+*/
+
+#endif /* Include guard */
projects / p5sagit/p5-mst-13.2.git / blobdiff