X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=b147654abd0cb2473fb5ad69d480e91e096d3e66;hb=eba1666137b7e1350d666a934a5e99ced3f50088;hp=f478c22b9f7a74875a6f4f0b4480919f7883f8f2;hpb=cd1541b29232033fba1800a2ccd9ae38b4e1b8c3;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index f478c22..b147654 100644 --- a/perl.h +++ b/perl.h @@ -1,7 +1,7 @@ /* 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. @@ -34,7 +34,11 @@ #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 for detailed notes on @@ -59,23 +63,24 @@ # 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 @@ -149,7 +154,7 @@ # define MULTIPLICITY # endif # define tTHX PerlInterpreter* -# define pTHX register tTHX my_perl PERL_UNUSED_DECL +# define pTHX register tTHX my_perl PERL_UNUSED_DECL # define aTHX my_perl # ifdef PERL_GLOBAL_STRUCT # define dTHXa(a) dVAR; pTHX = (tTHX)a @@ -190,16 +195,96 @@ #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) -/* XXX The PERL_UNUSED_DECL suffix is unfortunately rather inflexible: - * it assumes that in all compilers the way to suppress an "unused" - * warning is to have a suffix. In some compilers that might be a - * a compiler pragma, e.g. #pragma unused(varname). */ +#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 @@ -210,7 +295,7 @@ #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 @@ -222,7 +307,7 @@ * 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 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) # else @@ -233,8 +318,18 @@ # 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 @@ -315,10 +410,18 @@ * 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 @@ -329,12 +432,21 @@ register struct op *Perl_op asm(stringify(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 @@ -343,7 +455,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); * 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 @@ -361,16 +473,6 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #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 @@ -421,7 +523,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #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. @@ -566,11 +668,16 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #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 */ @@ -821,7 +928,9 @@ int usleep(unsigned int); /* 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) @@ -837,6 +946,10 @@ int usleep(unsigned int); */ #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 @@ -1115,6 +1228,26 @@ int sockatmark(int); # 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 @@ -1429,6 +1562,58 @@ int sockatmark(int); # 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 */ #ifdef UTS @@ -1594,12 +1779,6 @@ typedef UVTYPE UV; #define DBL_DIG 15 /* A guess that works lots of places */ #endif #endif -#ifdef I_FLOAT -#include -#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 */ @@ -2139,9 +2318,15 @@ int isnan(double d); #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; @@ -2317,6 +2502,10 @@ typedef struct clone_params CLONE_PARAMS; #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 @@ -2347,6 +2536,10 @@ typedef struct clone_params CLONE_PARAMS; #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 @@ -2438,10 +2631,10 @@ typedef struct clone_params CLONE_PARAMS; # if HAS_FLOATINGPOINT_H # include # 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 = (Sighandler_t) 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 @@ -2455,10 +2648,14 @@ typedef struct clone_params CLONE_PARAMS; # 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 @@ -2494,14 +2691,20 @@ typedef struct clone_params CLONE_PARAMS; * 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 (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 @@ -2515,9 +2718,12 @@ typedef struct clone_params CLONE_PARAMS; # 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 @@ -2866,12 +3072,9 @@ typedef pthread_key_t perl_key; These formats will still work in perl code. See comments in sv.c for futher details. - -DvdNUMBER= 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_ @@ -2890,20 +3093,24 @@ typedef pthread_key_t perl_key; # define SVf256 SVf_(256) #endif -#ifndef vdNUMBER -# define vdNUMBER 1 -#endif - -#ifndef VDf -# if vdNUMBER -# define VDf STRINGIFY(vdNUMBER) "p" -# else +#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 UVf -# define UVf UVuf + +#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 @@ -2955,9 +3162,27 @@ typedef pthread_key_t perl_key; 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 /* NOT REACHED */ return 0 +# 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 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 @@ -2976,8 +3201,8 @@ typedef pthread_key_t perl_key; # define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) # else # if defined(_IOC_SIZE) && defined(__GLIBC__) - /* on Linux systems we're safe */ -# define IOCPARM_LEN(x) _IOC_SIZE(x) + /* 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 @@ -3019,8 +3244,14 @@ union any { 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) @@ -3042,6 +3273,12 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ # 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 @@ -3052,6 +3289,23 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ # 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" @@ -3061,44 +3315,31 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.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 */ @@ -3225,6 +3466,10 @@ long vtohl(long n); #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) @@ -3273,7 +3518,8 @@ Gid_t getegid (void); #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 */ @@ -3303,6 +3549,7 @@ Gid_t getegid (void); # 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) @@ -3315,6 +3562,7 @@ Gid_t getegid (void); # 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 @@ -3330,9 +3578,9 @@ Gid_t getegid (void); # 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_ @@ -3342,6 +3590,8 @@ Gid_t getegid (void); # 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 @@ -3366,13 +3616,19 @@ Gid_t getegid (void); } 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) @@ -3397,9 +3653,9 @@ Gid_t getegid (void); # 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) @@ -3409,6 +3665,8 @@ Gid_t getegid (void); # 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) @@ -3424,9 +3682,9 @@ Gid_t getegid (void); # 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) @@ -3435,6 +3693,8 @@ Gid_t getegid (void); # define DEBUG_C(a) # define DEBUG_A(a) # define DEBUG_q(a) +# define DEBUG_Xv(a) +# define DEBUG_Uv(a) #endif /* DEBUGGING */ @@ -3465,12 +3725,13 @@ Gid_t getegid (void); #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 %_ 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 @@ -3656,7 +3915,7 @@ char *getlogin (void); /* Also rename() is affected by this */ #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ #define UNLINK unlnk -I32 unlnk (const char*); +I32 unlnk (pTHX_ const char*); #else #define UNLINK PerlLIO_unlink #endif @@ -3704,6 +3963,24 @@ typedef Sighandler_t Sigsave_t; # 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 \ @@ -3727,15 +4004,15 @@ typedef Sighandler_t Sigsave_t; #endif #if defined(PERL_IMPLICIT_CONTEXT) + +struct perl_memory_debug_header; struct perl_memory_debug_header { tTHX interpreter; # ifdef PERL_POISON MEM_SIZE size; - U8 in_use; # endif - -#define PERL_POISON_INUSE 29 -#define PERL_POISON_FREE 159 + struct perl_memory_debug_header *prev; + struct perl_memory_debug_header *next; }; # define sTHX (sizeof(struct perl_memory_debug_header) + \ @@ -3744,11 +4021,22 @@ struct perl_memory_debug_header { #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!@" @@ -3800,7 +4088,7 @@ EXTCONST char PL_no_usym[] 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[] @@ -3814,20 +4102,29 @@ EXTCONST char PL_no_dir_func[] 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"); 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 @@ -4045,6 +4342,111 @@ 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 /*****************************************************************************/ @@ -4062,15 +4464,6 @@ 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 { @@ -4118,17 +4511,19 @@ enum { /* pass one of these to get_vtbl */ 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 */ @@ -4143,6 +4538,8 @@ enum { /* pass one of these to get_vtbl */ #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 */ @@ -4150,11 +4547,7 @@ enum { /* pass one of these to get_vtbl */ #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 @@ -4188,9 +4581,10 @@ typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg, 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*); @@ -4226,6 +4620,10 @@ typedef struct exitlistentry { # 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" @@ -4256,13 +4654,7 @@ struct perl_vars *PL_VarsPtr; */ 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 @@ -4271,8 +4663,6 @@ struct interpreter { }; #endif /* MULTIPLICITY */ -typedef void *Thread; - /* Done with PERLVAR macros for now ... */ #undef PERLVAR #undef PERLVARA @@ -4286,7 +4676,11 @@ struct tempsym; /* defined in pp_pack.c */ #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 @@ -4303,6 +4697,12 @@ struct tempsym; /* defined in pp_pack.c */ #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 @@ -4318,13 +4718,16 @@ struct tempsym; /* defined in pp_pack.c */ #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 @@ -4342,62 +4745,90 @@ END_EXTERN_C 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 @@ -4405,416 +4836,355 @@ MGVTBL_SET( 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, smart_amg, - - /* Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry */ - 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; @@ -4881,7 +5251,6 @@ 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)) @@ -4903,7 +5272,7 @@ typedef struct am_table_short AMTS; #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 \ @@ -4993,7 +5362,7 @@ typedef struct am_table_short AMTS; # 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 @@ -5088,12 +5457,14 @@ typedef struct am_table_short AMTS; /* * 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. @@ -5107,38 +5478,68 @@ typedef struct am_table_short AMTS; #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) -/* 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) +/* 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 \ - 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] + +/* 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 \ + +#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 \ + 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 */ @@ -5153,7 +5554,7 @@ typedef struct am_table_short AMTS; #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 @@ -5169,7 +5570,7 @@ typedef struct am_table_short AMTS; #define aMY_CXT_ #define _aMY_CXT -#endif /* !defined(USE_ITHREADS) */ +#endif /* !defined(PERL_IMPLICIT_CONTEXT) */ #ifdef I_FCNTL # include @@ -5358,6 +5759,7 @@ extern void moncontrol(int); #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 | \ @@ -5373,7 +5775,7 @@ extern void moncontrol(int); 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' @@ -5385,6 +5787,7 @@ extern void moncontrol(int); #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 @@ -5437,12 +5840,44 @@ extern void moncontrol(int); # define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0) #endif -/* and finally... */ -#define PERL_PATCHLEVEL_H_IMPLICIT -#include "patchlevel.h" -#undef PERL_PATCHLEVEL_H_IMPLICIT +#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 + +#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 -/* Mention +#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 @@ -5482,7 +5917,10 @@ extern void moncontrol(int); 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 */