# endif
#endif
+/* This logic needs to come after reading config.h, but before including
+ proto.h */
+#ifdef IAMSUID
+# ifndef DOSUID
+# define DOSUID
+# endif
+#endif
+
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+# ifdef DOSUID
+# undef DOSUID
+# endif
+# ifdef IAMSUID
+# undef IAMSUID
+# define SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID
+# endif
+#endif
+
/* See L<perlguts/"The Perl API"> for detailed notes on
* PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
#define CALLRUNOPS CALL_FPTR(PL_runops)
-#define CALLREGCOMP(exp, xend, pm) Perl_pregcomp(aTHX_ (exp),(xend),(pm))
+#define CALLREGCOMP(sv, flags) Perl_pregcomp(aTHX_ (sv),(flags))
-#define CALLREGCOMP_ENG(prog, exp, xend, pm) \
- CALL_FPTR(((prog)->comp))(aTHX_ exp, xend, pm)
+#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), \
+ CALL_FPTR(RX_ENGINE(prog)->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), \
+ CALL_FPTR(RX_ENGINE(prog)->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)
+ CALL_FPTR(RX_ENGINE(prog)->checkstr)(aTHX_ (prog))
#define CALLREGFREE(prog) \
Perl_pregfree(aTHX_ (prog))
#define CALLREGFREE_PVT(prog) \
- if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog))
+ if(prog) CALL_FPTR(RX_ENGINE(prog)->free)(aTHX_ (prog))
+
+#define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \
+ CALL_FPTR(RX_ENGINE(rx)->numbered_buff_FETCH)(aTHX_ (rx),(paren),(usesv))
+
+#define CALLREG_NUMBUF_STORE(rx,paren,value) \
+ CALL_FPTR(RX_ENGINE(rx)->numbered_buff_STORE)(aTHX_ (rx),(paren),(value))
+
+#define CALLREG_NUMBUF_LENGTH(rx,sv,paren) \
+ CALL_FPTR(RX_ENGINE(rx)->numbered_buff_LENGTH)(aTHX_ (rx),(sv),(paren))
+
+#define CALLREG_NAMED_BUFF_FETCH(rx, key, flags) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH))
+
+#define CALLREG_NAMED_BUFF_STORE(rx, key, value, flags) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE))
+
+#define CALLREG_NAMED_BUFF_DELETE(rx, key, flags) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE))
+
+#define CALLREG_NAMED_BUFF_CLEAR(rx, flags) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR))
+
+#define CALLREG_NAMED_BUFF_EXISTS(rx, key, flags) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS))
+
+#define CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff_iter)(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY))
+
+#define CALLREG_NAMED_BUFF_NEXTKEY(rx, lastkey, flags) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff_iter)(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY))
+
+#define CALLREG_NAMED_BUFF_SCALAR(rx, flags) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR))
+
+#define CALLREG_NAMED_BUFF_COUNT(rx) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT)
+
+#define CALLREG_NAMED_BUFF_ALL(rx, flags) \
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, flags)
+
+#define CALLREG_PACKAGE(rx) \
+ CALL_FPTR(RX_ENGINE(rx)->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)) \
+ (prog ? CALL_FPTR(RX_ENGINE(prog)->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.
/* 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))
+ * (insane errors ensue).
+ * g++ does not give insane errors now (RMB 2008-01-30, gcc 4.2.2).
+ */
+#if defined(PERL_GCC_PEDANTIC) || \
+ (defined(__GNUC__) && defined(__cplusplus) && \
+ ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 2))))
# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
# endif
#endif
#if defined(HASVOLATILE) || defined(STANDARD_C)
-# ifdef __cplusplus
-# define VOL /* to temporarily suppress warnings */
-# else
# define VOL volatile
-# endif
#else
# define VOL
#endif
EXTERN_C int usleep(unsigned int);
#endif
+/* Funky places that do not have socket stuff. */
+#if defined(__LIBCATAMOUNT__)
+# define MYSWAP
+#endif
+
#ifdef PERL_MICRO /* Last chance to export Perl_my_swap */
# define MYSWAP
#endif
#define PERL_ARENA_SIZE 4080
#endif
+/* Maximum level of recursion */
+#ifndef PERL_SUB_DEPTH_WARN
+#define PERL_SUB_DEPTH_WARN 100
+#endif
+
#endif /* PERL_CORE */
/* We no longer default to creating a new SV for GvSV.
EXTERN_C char **environ;
#endif
-#if defined(__OpenBSD__) && defined(__cplusplus)
+#if defined(__cplusplus)
+# if defined(__OpenBSD__) || defined(__FreeBSD__) || defined(__NetBSD__)
EXTERN_C char **environ;
-#endif
-
-#if defined(__CYGWIN__) && defined(__cplusplus)
+# elif defined(__CYGWIN__)
EXTERN_C char *crypt(const char *, const char *);
#endif
+#endif
#ifdef SETERRNO
# undef SETERRNO /* SOCKS might have defined this */
typedef struct av AV;
typedef struct hv HV;
typedef struct cv CV;
-typedef struct regexp REGEXP;
+typedef struct regexp ORANGE; /* This is the body structure. */
+typedef struct p5rx REGEXP;
typedef struct gp GP;
typedef struct gv GV;
typedef struct io IO;
# 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
* have HASATTRIBUTE_FORMAT).
*/
+#ifndef PERL_MICRO
#if defined __GNUC__ && !defined(__INTEL_COMPILER)
# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
# define HASATTRIBUTE_FORMAT
# define HASATTRIBUTE_WARN_UNUSED_RESULT
# endif
#endif
+#endif /* #ifndef PERL_MICRO */
/* USE_5005THREADS needs to be after unixish.h as <pthread.h> includes
* <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
These formats will still work in perl code.
See comments in sv.c for futher details.
- -DvdNUMBER=<number> can be used to redefine VDf
-
- -DvdNUMBER=0 reverts VDf to "vd", as in perl5.8.7,
- which works properly but gives compiler warnings
-
Robin Barker 2005-07-14
+
+ No longer use %1p for VDf = %vd. RMB 2007-10-19
*/
#ifndef SVf_
#define SVfARG(p) ((void*)(p))
-#ifndef vdNUMBER
-# define vdNUMBER 1
-#endif
-
-#ifndef VDf
-# if vdNUMBER
-# define VDf STRINGIFY(vdNUMBER) "p"
-# else
+#ifdef PERL_CORE
+/* not used; but needed for backward compatibilty with XS code? - RMB */
+# undef VDf
+#else
+# ifndef VDf
# define VDf "vd"
# endif
#endif
-
+
+#ifdef PERL_CORE
/* not used; but needed for backward compatibilty with XS code? - RMB */
-#ifndef UVf
-# define UVf UVuf
+# undef UVf
+#else
+# ifndef UVf
+# define UVf UVuf
+# endif
#endif
#ifdef HASATTRIBUTE_FORMAT
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
};
#endif
-#include "regexp.h"
+/* macros to define bit-fields in structs. */
+#ifndef PERL_BITFIELD8
+# define PERL_BITFIELD8 unsigned
+#endif
+#ifndef PERL_BITFIELD16
+# define PERL_BITFIELD16 unsigned
+#endif
+#ifndef PERL_BITFIELD32
+# define PERL_BITFIELD32 unsigned
+#endif
+
#include "sv.h"
+#include "regexp.h"
#include "util.h"
#include "form.h"
#include "gv.h"
#include "warnings.h"
#include "utf8.h"
+/* defined in sv.c, but also used in [ach]v.c */
+#undef _XPV_ALLOCATED_HEAD
+#undef _XPV_HEAD
+#undef _XPVMG_HEAD
+#undef _XPVCV_COMMON
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"
#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_H_FLAG 0x00002000 /* 8192 */
#define DEBUG_X_FLAG 0x00004000 /* 16384 */
#define DEBUG_D_FLAG 0x00008000 /* 32768 */
-#define DEBUG_S_FLAG 0x00010000 /* 65536 */
+/* 0x00010000 is unused, used to be S */
#define DEBUG_T_FLAG 0x00020000 /* 131072 */
#define DEBUG_R_FLAG 0x00040000 /* 262144 */
#define DEBUG_J_FLAG 0x00080000 /* 524288 */
#define DEBUG_C_FLAG 0x00200000 /*2097152 */
#define DEBUG_A_FLAG 0x00400000 /*4194304 */
#define DEBUG_q_FLAG 0x00800000 /*8388608 */
-#define DEBUG_MASK 0x00FFEFFF /* mask of all the standard flags */
+#define DEBUG_MASK 0x00FEEFFF /* 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_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_S_TEST_ (PL_debug & DEBUG_S_FLAG)
# define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG)
# define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
# define DEBUG_J_TEST_ (PL_debug & DEBUG_J_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_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_R_TEST DEBUG_R_TEST_
# define DEBUG_J_TEST DEBUG_J_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
# 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_S(a)
+# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
+# define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a)
# define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a)
# define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
# 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_R_TEST (0)
# define DEBUG_J_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_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_R(a)
# define DEBUG_v(a)
# define DEBUG_C(a)
# define DEBUG_A(a)
# define DEBUG_q(a)
+# define DEBUG_Xv(a)
+# define DEBUG_Uv(a)
#endif /* DEBUGGING */
#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_arylen_p '@' /* to move arylen out of XPVAV */
#define PERL_MAGIC_ext '~' /* Available for use by extensions */
+#if defined(DEBUGGING) && defined(I_ASSERT)
+# include <assert.h>
+#endif
+
+/* Keep the old croak based assert for those who want it, and as a fallback if
+ the platform is so heretically non-ANSI that it can't assert. */
-#ifndef assert /* <assert.h> might have been included somehow */
-#define assert(what) PERL_DEB( \
+#define Perl_assert(what) PERL_DEB( \
((what) ? ((void) 0) : \
(Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \
"\", line %d", STRINGIFY(what), __LINE__), \
(void) 0)))
+
+#ifndef assert
+# define assert(what) Perl_assert(what)
#endif
struct ufuncs {
#endif
#ifdef USE_PERLIO
-EXTERN_C PERL_EXPORT_C void PerlIO_teardown(pTHX);
+EXTERN_C void PerlIO_teardown(void);
# ifdef USE_ITHREADS
# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex)
# define PERLIO_TERM \
STMT_START { \
- PerlIO_teardown(aTHX); \
+ PerlIO_teardown(); \
MUTEX_DESTROY(&PL_perlio_mutex);\
} STMT_END
# else
# define PERLIO_INIT
-# define PERLIO_TERM PerlIO_teardown(aTHX)
+# define PERLIO_TERM PerlIO_teardown()
# endif
#else
# define PERLIO_INIT
(MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
%MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
+#else
+# define sTHX 0
#endif
#ifdef PERL_TRACK_MEMPOOL
# define INIT_TRACK_MEMPOOL(header, interp)
#endif
+#ifdef I_MALLOCMALLOC
+/* Needed for malloc_size(), malloc_good_size() on some systems */
+# include <malloc/malloc.h>
+#endif
+
+#ifdef MYMALLOC
+# define Perl_safesysmalloc_size(where) Perl_malloced_size(where)
+#else
+# ifdef HAS_MALLOC_SIZE
+# ifdef PERL_TRACK_MEMPOOL
+# define Perl_safesysmalloc_size(where) \
+ (malloc_size(((char *)(where)) - sTHX) - sTHX)
+# else
+# define Perl_safesysmalloc_size(where) malloc_size(where)
+# endif
+# endif
+# ifdef HAS_MALLOC_GOOD_SIZE
+# ifdef PERL_TRACK_MEMPOOL
+# define Perl_malloc_good_size(how_much) \
+ (malloc_good_size((how_much) + sTHX) - sTHX)
+# else
+# define Perl_malloc_good_size(how_much) malloc_good_size(how_much)
+# endif
+# else
+/* Having this as the identity operation makes some code simpler. */
+# define Perl_malloc_good_size(how_much) (how_much)
+# endif
+#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_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
#ifdef DOINIT
EXTCONST char* const PL_block_type[] = {
"NULL",
- "SUB",
- "EVAL",
- "LOOP",
- "SUBST",
+ "WHEN",
"BLOCK",
- "FORMAT",
"GIVEN",
- "WHEN"
+ "LOOP_FOR",
+ "LOOP_PLAIN",
+ "LOOP_LAZYSV",
+ "LOOP_LAZYIV",
+ "SUB",
+ "FORMAT",
+ "EVAL",
+ "SUBST"
};
#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
/*****************************************************************************/
#define HINT_NEW_STRING 0x00008000
#define HINT_NEW_RE 0x00010000
#define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */
-#define HINT_LEXICAL_IO 0x00040000 /* ${^OPEN} is set */
+#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, stored in $^H{assertions} */
-#define HINT_ASSERTING 0x00000001
-#define HINT_ASSERTIONSSEEN 0x00000002
-
/* 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
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*);
-typedef void (*SVFUNC_t) (pTHX_ SV*);
-typedef I32 (*SVCOMPARE_t) (pTHX_ SV*, SV*);
+typedef void (*SVFUNC_t) (pTHX_ SV* const);
+typedef I32 (*SVCOMPARE_t) (pTHX_ SV* const, SV* const);
typedef void (*XSINIT_t) (pTHX);
typedef void (*ATEXIT_t) (pTHX_ void*);
typedef void (*XSUBADDR_t) (pTHX_ CV *);
# 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
#if !defined(MULTIPLICITY)
START_EXTERN_C
# include "intrpvar.h"
-# include "thrdvar.h"
END_EXTERN_C
#endif
+#ifdef PERL_CORE
+/* All core uses now exterminated. Ensure no zombies can return: */
+# undef PL_na
+#endif
+
#if defined(WIN32)
/* Now all the config stuff is setup we can include embed.h */
# include "embed.h"
# 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,
- 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,
- 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,
- NULL
+ 0,
+ 0,
+ 0,
+ 0
);
-/* For now, hints magic will also use vtbl_sig, because it is all NULL */
+/* 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,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
#ifdef PERL_MICRO
MGVTBL_SET(
PL_vtbl_sigelem,
- NULL,
- 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,
- 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,
- 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,
- NULL
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_dbline,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setdbline),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_isa,
- NULL,
- MEMBER_TO_FPTR(Perl_magic_setisa),
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setisa),
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ MEMBER_TO_FPTR(Perl_magic_clearisa),
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_isaelem,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setisa),
- NULL,
- 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,
- 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,
- NULL
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_mglob,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setmglob),
- NULL,
- 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,
- 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,
- 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,
- 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,
- 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,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_bm,
- NULL,
- MEMBER_TO_FPTR(Perl_magic_setbm),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ MEMBER_TO_FPTR(Perl_magic_setregexp),
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_fm,
- NULL,
- MEMBER_TO_FPTR(Perl_magic_setfm),
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ MEMBER_TO_FPTR(Perl_magic_setregexp),
+ 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,
- 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,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_regexp,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setregexp),
- NULL,
- NULL,
- MEMBER_TO_FPTR(Perl_magic_freeregexp),
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_regdata,
- NULL,
- NULL,
+ 0,
+ 0,
MEMBER_TO_FPTR(Perl_magic_regdata_cnt),
- NULL,
- 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,
- 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,
- 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,
- 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,
- 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,
- NULL
+ 0,
+ 0,
+ 0
);
MGVTBL_SET(
PL_vtbl_utf8,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_setutf8),
- NULL,
- 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,
- NULL
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0
);
#endif
MGVTBL_SET(
PL_vtbl_hintselem,
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_sethint),
- NULL,
+ 0,
MEMBER_TO_FPTR(Perl_magic_clearhint),
- NULL,
- NULL,
- NULL,
- NULL
+ 0,
+ 0,
+ 0,
+ 0
);
#include "overload.h"
U32 flags;
U32 was_ok_sub;
long was_ok_am;
- CV* table[NofAMmeth];
long fallback;
+ CV* table[NofAMmeth];
};
struct am_table_short {
U32 flags;
#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 START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV dNOOP
#define dMY_CXT dNOOP
+#define dMY_CXT_INTERP(my_perl) dNOOP
#define MY_CXT_INIT NOOP
#define MY_CXT_CLONE NOOP
#define MY_CXT my_cxt
#endif
#ifndef EXEC_ARGV_CAST
-#define EXEC_ARGV_CAST(x) x
+#define EXEC_ARGV_CAST(x) (char **)x
#endif
#define IS_NUMBER_IN_UV 0x01 /* number within UV range (maybe not
#define NO_ENV_ARRAY_IN_MAIN
#endif
-/* and finally... */
-#define PERL_PATCHLEVEL_H_IMPLICIT
-#include "patchlevel.h"
-#undef PERL_PATCHLEVEL_H_IMPLICIT
-
/* 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
#define PERL_PV_ESCAPE_QUOTE 0x0001
#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
-
-#define PERL_PV_PRETTY_ELIPSES 0x0002
+#define PERL_PV_PRETTY_ELLIPSES 0x0002
#define PERL_PV_PRETTY_LTGT 0x0004
#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
#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_ELIPSES|PERL_PV_PRETTY_QUOTE
-#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
+#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
/*
#endif /* Include guard */
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
https://perl5.git.perl.org / perl5.git / blobdiff