X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/10edeb5d2457364a70a6848a864cfa6b89dfc882..6de131f0f0b420a4dd91ca25f6afce86a924ace9:/perl.h diff --git a/perl.h b/perl.h index 9d2611f..874d0c3 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, 2006, by Larry Wall and others + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 + * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 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. @@ -127,10 +127,23 @@ # endif #endif +#undef START_EXTERN_C +#undef END_EXTERN_C +#undef EXTERN_C +#ifdef __cplusplus +# define START_EXTERN_C extern "C" { +# define END_EXTERN_C } +# define EXTERN_C extern "C" +#else +# define START_EXTERN_C +# define END_EXTERN_C +# define EXTERN_C extern +#endif + #ifdef PERL_GLOBAL_STRUCT # ifndef PERL_GET_VARS # ifdef PERL_GLOBAL_STRUCT_PRIVATE - extern struct perl_vars* Perl_GetVarsPrivate(); + EXTERN_C struct perl_vars* Perl_GetVarsPrivate(); # define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */ # ifndef PERLIO_FUNCS_CONST # define PERLIO_FUNCS_CONST /* Can't have these lying around. */ @@ -195,11 +208,80 @@ #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) + +#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(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(RX_ENGINE(prog)->intuit)(aTHX_ (prog), (sv), (strpos), \ + (strend),(flags),(data)) +#define CALLREG_INTUIT_STRING(prog) \ + CALL_FPTR(RX_ENGINE(prog)->checkstr)(aTHX_ (prog)) + +#define CALLREGFREE(prog) \ + Perl_pregfree(aTHX_ (prog)) + +#define CALLREGFREE_PVT(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(RX_ENGINE(prog)->dupe)(aTHX_ (prog),(param)) \ + : (REGEXP *)NULL) +#endif + + + + /* * Because of backward compatibility reasons the PERL_UNUSED_DECL @@ -318,29 +400,24 @@ # endif #endif -#undef START_EXTERN_C -#undef END_EXTERN_C -#undef EXTERN_C -#ifdef __cplusplus -# define START_EXTERN_C extern "C" { -# define END_EXTERN_C } -# define EXTERN_C extern "C" -#else -# define START_EXTERN_C -# define END_EXTERN_C -# define EXTERN_C extern -#endif - /* Some platforms require marking function declarations * for them to be exportable. Used in perlio.h, proto.h * is handled either by the makedef.pl or by defining the * PERL_CALLCONV to be something special. See also the * definition of XS() in XSUB.h. */ #ifndef PERL_EXPORT_C -# define PERL_EXPORT_C extern +# 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 @@ -351,10 +428,14 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # endif #endif -/* gcc (-ansi) -pedantic doesn't allow gcc brace groups, +/* 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 @@ -429,11 +510,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #endif #if defined(HASVOLATILE) || defined(STANDARD_C) -# ifdef __cplusplus -# define VOL /* to temporarily suppress warnings */ -# else # define VOL volatile -# endif #else # define VOL #endif @@ -582,16 +659,26 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # include #endif +/* for WCOREDUMP */ +#ifdef I_SYS_WAIT +# include +#endif + #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 */ @@ -837,6 +924,11 @@ int usleep(unsigned int); #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. @@ -851,7 +943,7 @@ int usleep(unsigned int); #define PERL_USES_PL_PIDSTATUS #endif -#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL) +#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) #define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION #endif @@ -935,6 +1027,7 @@ int usleep(unsigned int); # define MALLOC_CHECK_TAINT(argc,argv,env) #endif /* MYMALLOC */ +/* diag_listed_as: "-T" is on the #! line, it must also be used on the command line */ #define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what) #define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "") #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") @@ -1051,6 +1144,13 @@ int usleep(unsigned int); # include #endif +/* Microsoft VC's sys/stat.h defines all S_Ixxx macros except S_IFIFO. + This definition should ideally go into win32/win32.h, but S_IFIFO is + used later here in perl.h before win32/win32.h is being included. */ +#if !defined(S_IFIFO) && defined(_S_IFIFO) +# define S_IFIFO _S_IFIFO +#endif + /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives like UTekV) are broken, sometimes giving false positives. Undefine them here and let the code below set them to proper values. @@ -1142,6 +1242,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 @@ -1152,6 +1272,11 @@ int sockatmark(int); set_errno(errcode); \ set_vaxc_errno(vmserrcode); \ } STMT_END +# define dSAVEDERRNO int saved_errno; unsigned saved_vms_errno +# define dSAVE_ERRNO int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno +# define SAVE_ERRNO ( saved_errno = errno, saved_vms_errno = vaxc$errno ) +# define RESTORE_ERRNO SETERRNO(saved_errno, saved_vms_errno) + # define LIB_INVARG LIB$_INVARG # define RMS_DIR RMS$_DIR # define RMS_FAC RMS$_FAC @@ -1166,6 +1291,11 @@ int sockatmark(int); # define SS_NORMAL SS$_NORMAL #else # define SETERRNO(errcode,vmserrcode) (errno = (errcode)) +# define dSAVEDERRNO int saved_errno +# define dSAVE_ERRNO int saved_errno = errno +# define SAVE_ERRNO (saved_errno = errno) +# define RESTORE_ERRNO (errno = saved_errno) + # define LIB_INVARG 0 # define RMS_DIR 0 # define RMS_FAC 0 @@ -1181,8 +1311,12 @@ int sockatmark(int); #endif #define ERRSV GvSV(PL_errgv) -/* FIXME? Change the assignments to PL_defgv to instantiate GvSV? */ -#define DEFSV GvSVn(PL_defgv) +#ifdef PERL_CORE +# define DEFSV (0 + GvSVn(PL_defgv)) +#else +# define DEFSV GvSVn(PL_defgv) +#endif +#define DEFSV_set(sv) (GvSV(PL_defgv) = (sv)) #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */ @@ -1414,15 +1548,15 @@ int sockatmark(int); # define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) #endif -/* BeOS 5.0 seems to define S_IREAD and S_IWRITE in +/* BeOS 5.0 and Haiku R1 seem to define S_IREAD and S_IWRITE in * which would get included through , but that is 3000 * lines in the future. --jhi */ -#if !defined(S_IREAD) && !defined(__BEOS__) +#if !defined(S_IREAD) && !(defined(__BEOS__) || defined(__HAIKU__)) # define S_IREAD S_IRUSR #endif -#if !defined(S_IWRITE) && !defined(__BEOS__) +#if !defined(S_IWRITE) && !(defined(__BEOS__) || defined(__HAIKU__)) # define S_IWRITE S_IWUSR #endif @@ -1460,9 +1594,10 @@ int sockatmark(int); * 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 brace groups, then use the function wrappers which try to trap - * the overflow. If we can use the gcc brace groups, we can try that - * even with the version that uses the C99 variadic macros. + * 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 @@ -1471,9 +1606,9 @@ int sockatmark(int); * 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)) +#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(aTHX_ "panic: snprintf buffer overflow"); __len__; }) +# 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__) @@ -1483,9 +1618,9 @@ int sockatmark(int); # define PERL_MY_SNPRINTF_GUARDED #endif -#if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) +#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(aTHX_ "panic: vsnprintf buffer overflow"); __len__; }) +# 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__) @@ -1672,12 +1807,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 */ @@ -2251,7 +2380,8 @@ typedef struct STRUCT_SV SV; 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; @@ -2380,7 +2510,7 @@ typedef struct clone_params CLONE_PARAMS; # endif #endif -#if defined(OS2) || defined(MACOS_TRADITIONAL) +#if defined(OS2) # include "iperlsys.h" #endif @@ -2442,15 +2572,11 @@ typedef struct clone_params CLONE_PARAMS; # define ISHISH "symbian" #endif -#if defined(MACOS_TRADITIONAL) -# include "macos/macish.h" -# ifndef NO_ENVIRON_ARRAY -# define NO_ENVIRON_ARRAY -# endif -# define ISHISH "macos classic" -#endif -#if defined(__BEOS__) +#if defined(__HAIKU__) +# include "haiku/haikuish.h" +# define ISHISH "haiku" +#elif defined(__BEOS__) # include "beos/beosish.h" # define ISHISH "beos" #endif @@ -2530,10 +2656,14 @@ typedef struct clone_params CLONE_PARAMS; # if HAS_FLOATINGPOINT_H # include # endif -# define PERL_FPU_INIT fpsetmask(0); +/* Some operating systems have this as a macro, which in turn expands to a comma + expression, and the last sub-expression is something that gets calculated, + and then they have the gall to warn that a value computed is not used. Hence + cast to void. */ +# define PERL_FPU_INIT (void)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 @@ -2547,10 +2677,33 @@ 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 +/* +=for apidoc Am|void|PERL_SYS_INIT|int argc|char** argv +Provides system-specific tune up of the C runtime environment necessary to +run Perl interpreters. This should be called only once, before creating +any Perl interpreters. + +=for apidoc Am|void|PERL_SYS_INIT3|int argc|char** argv|char** env +Provides system-specific tune up of the C runtime environment necessary to +run Perl interpreters. This should be called only once, before creating +any Perl interpreters. + +=for apidoc Am|void|PERL_SYS_TERM| +Provides system-specific clean up of the C runtime environment after +running Perl interpreters. This should be called only once, after +freeing any remaining Perl interpreters. + +=cut + */ + +#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 @@ -2594,9 +2747,16 @@ typedef struct clone_params CLONE_PARAMS; * have HASATTRIBUTE_FORMAT). */ +#ifndef PERL_MICRO #if defined __GNUC__ && !defined(__INTEL_COMPILER) +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */ +# define HASATTRIBUTE_DEPRECATED +# endif # 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 @@ -2620,6 +2780,7 @@ typedef struct clone_params CLONE_PARAMS; # define HASATTRIBUTE_WARN_UNUSED_RESULT # endif #endif +#endif /* #ifndef PERL_MICRO */ /* USE_5005THREADS needs to be after unixish.h as includes * which defines NSIG - which will stop inclusion of @@ -2774,11 +2935,11 @@ typedef pthread_key_t perl_key; } 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. + * the NATIVE error status based on it. + * + * When in the default mode to comply with the Perl VMS documentation, + * 0 is a success and 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 @@ -2792,30 +2953,31 @@ typedef pthread_key_t perl_key; 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); \ + if (MY_POSIX_EXIT) { \ + if (evalue <= 0xFF00) { \ + if (evalue > 0xFF) \ + evalue = (evalue >> child_offset_bits) & 0xFF; \ + PL_statusvalue_vms = \ + (C_FAC_POSIX | (evalue << 3 ) | \ + ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \ + } else /* forgive them Perl, for they have sinned */ \ + PL_statusvalue_vms = evalue; \ + } else { \ + if (evalue == 0) \ + PL_statusvalue_vms = SS$_NORMAL; \ + else if (evalue <= 0xFF00) \ + 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; \ + } \ + set_vaxc_errno(PL_statusvalue_vms); \ + } \ } STMT_END + /* 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. @@ -2828,6 +2990,9 @@ typedef pthread_key_t perl_key; * actual exit code will can be retrieved by the calling program or * shell. * + * A POSIX exit code is from 0 to 255. If the exit code is higher + * than this, it needs to be assumed that it is a VMS exit code and + * passed through. */ # define STATUS_EXIT_SET(n) \ @@ -2835,9 +3000,10 @@ typedef pthread_key_t perl_key; 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); \ + if (evalue > 255) PL_statusvalue_vms = evalue; else { \ + 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); \ @@ -2914,10 +3080,18 @@ typedef pthread_key_t perl_key; # define MEMBER_TO_FPTR(name) name #endif +#ifndef PERL_CORE /* format to use for version numbers in file/directory names */ /* XXX move to Configure? */ -#ifndef PERL_FS_VER_FMT -# define PERL_FS_VER_FMT "%d.%d.%d" +/* This was only ever used for the current version, and that can be done at + compile time, as PERL_FS_VERSION, so should we just delete it? */ +# ifndef PERL_FS_VER_FMT +# define PERL_FS_VER_FMT "%d.%d.%d" +# endif +#endif + +#ifndef PERL_FS_VERSION +# define PERL_FS_VERSION PERL_VERSION_STRING #endif /* This defines a way to flush all output buffers. This may be a @@ -2964,12 +3138,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_ @@ -2988,22 +3159,37 @@ 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 + +#if !defined(PERL_CORE) && !defined(PERL_NO_SHORT_NAMES) +# if defined(PERL_IMPLICIT_CONTEXT) +# define pmflag(a,b) Perl_pmflag(aTHX_ a,b) +# else +# define pmflag Perl_pmflag +# endif #endif +#ifdef HASATTRIBUTE_DEPRECATED +# define __attribute__deprecated__ __attribute__((deprecated)) +#endif #ifdef HASATTRIBUTE_FORMAT # define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) #endif @@ -3027,6 +3213,9 @@ typedef pthread_key_t perl_key; #endif /* If we haven't defined the attributes yet, define them to blank. */ +#ifndef __attribute__deprecated__ +# define __attribute__deprecated__ +#endif #ifndef __attribute__format__ # define __attribute__format__(x,y,z) #endif @@ -3058,6 +3247,13 @@ typedef pthread_key_t perl_key; # 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 @@ -3128,8 +3324,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) @@ -3147,10 +3349,16 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ #endif /* threading */ #endif /* AIX */ -#if !defined(OS2) && !defined(MACOS_TRADITIONAL) +#if !defined(OS2) # 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 @@ -3178,8 +3386,19 @@ struct nexttoken { }; #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" @@ -3195,16 +3414,22 @@ struct nexttoken { #include "warnings.h" #include "utf8.h" +/* defined in sv.c, but also used in [ach]v.c */ +#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" + typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ struct scan_data_t; /* Used in S_* functions in regcomp.c */ @@ -3336,6 +3561,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) @@ -3384,11 +3613,12 @@ 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 */ -#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 */ @@ -3396,7 +3626,9 @@ Gid_t getegid (void); #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_M_FLAG 0x01000000 /*16777216*/ +#define DEBUG_B_FLAG 0x02000000 /*33554432*/ +#define DEBUG_MASK 0x03FEEFFF /* mask of all the standard flags */ #define DEBUG_DB_RECURSE_FLAG 0x40000000 #define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal @@ -3414,10 +3646,10 @@ 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) -# 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) @@ -3425,7 +3657,10 @@ Gid_t getegid (void); # define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG) # define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG) # define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG) +# define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG) +# define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG) # define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_) +# define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_) #ifdef DEBUGGING @@ -3441,11 +3676,10 @@ 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_ # define DEBUG_R_TEST DEBUG_R_TEST_ # define DEBUG_J_TEST DEBUG_J_TEST_ @@ -3453,6 +3687,10 @@ 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_M_TEST DEBUG_M_TEST_ +# define DEBUG_B_TEST DEBUG_B_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 @@ -3477,15 +3715,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_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) @@ -3493,6 +3735,8 @@ Gid_t getegid (void); # define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a) # define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a) # define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a) +# define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a) +# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a) #else /* DEBUGGING */ @@ -3508,11 +3752,10 @@ 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) # define DEBUG_R_TEST (0) # define DEBUG_J_TEST (0) @@ -3520,6 +3763,10 @@ Gid_t getegid (void); # define DEBUG_C_TEST (0) # define DEBUG_A_TEST (0) # define DEBUG_q_TEST (0) +# define DEBUG_M_TEST (0) +# define DEBUG_B_TEST (0) +# define DEBUG_Xv_TEST (0) +# define DEBUG_Uv_TEST (0) # define PERL_DEB(a) # define PERL_DEBUG(a) @@ -3535,17 +3782,20 @@ 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) # define DEBUG_R(a) # define DEBUG_v(a) # define DEBUG_C(a) # define DEBUG_A(a) # define DEBUG_q(a) +# define DEBUG_M(a) +# define DEBUG_B(a) +# define DEBUG_Xv(a) +# define DEBUG_Uv(a) #endif /* DEBUGGING */ @@ -3583,7 +3833,6 @@ Gid_t getegid (void); #define PERL_MAGIC_nkeys 'k' /* scalar(keys()) lvalue */ #define PERL_MAGIC_dbfile 'L' /* Debugger %_ +#endif -#ifndef assert /* might have been included somehow */ -#define assert(what) PERL_DEB( \ +/* 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. */ + +#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 { @@ -3815,6 +4072,24 @@ typedef Sighandler_t Sigsave_t; # define RUNOPS_DEFAULT Perl_runops_standard #endif +#ifdef USE_PERLIO +EXTERN_C void PerlIO_teardown(void); +# 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 \ @@ -3853,6 +4128,8 @@ struct perl_memory_debug_header { (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \ %MEM_ALIGNBYTES) % MEM_ALIGNBYTES) +#else +# define sTHX 0 #endif #ifdef PERL_TRACK_MEMPOOL @@ -3865,11 +4142,40 @@ struct perl_memory_debug_header { # define INIT_TRACK_MEMPOOL(header, interp) #endif +#ifdef I_MALLOCMALLOC +/* Needed for malloc_size(), malloc_good_size() on some systems */ +# include +#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!@" @@ -3913,15 +4219,15 @@ EXTCONST char PL_warn_nl[] EXTCONST char PL_no_wrongref[] INIT("Can't use %s ref as %s ref"); EXTCONST char PL_no_symref[] - INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); + INIT("Can't use string (\"%.32s\"%s) as %s ref while \"strict refs\" in use"); EXTCONST char PL_no_symref_sv[] - INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use"); + INIT("Can't use string (\"%" SVf32 "\"%s) as %s ref while \"strict refs\" in use"); EXTCONST char PL_no_usym[] INIT("Can't use an undefined value as %s reference"); EXTCONST char PL_no_aelem[] INIT("Modification of non-creatable array value attempted, subscript %d"); EXTCONST char PL_no_helem_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[] @@ -3941,14 +4247,27 @@ EXTCONST char PL_no_localize_ref[] 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 PL_bitcount[256] = +# include "bitcount.h" +; EXTCONST char* const PL_sig_name[] = { SIG_NAME }; EXTCONST int PL_sig_num[] = { SIG_NUM }; #else +EXTCONST char PL_uudmap[256]; +EXTCONST char PL_bitcount[256]; EXTCONST char* const PL_sig_name[]; EXTCONST int PL_sig_num[]; #endif @@ -4152,20 +4471,128 @@ EXTCONST unsigned char PL_freq[]; #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 /*****************************************************************************/ @@ -4231,7 +4658,8 @@ enum { /* pass one of these to get_vtbl */ want_vtbl_utf8, want_vtbl_symtab, want_vtbl_arylen_p, - want_vtbl_hintselem + want_vtbl_hintselem, + want_vtbl_hints }; @@ -4249,6 +4677,7 @@ enum { /* pass one of these to get_vtbl */ #define HINT_BLOCK_SCOPE 0x00000100 #define HINT_STRICT_SUBS 0x00000200 /* strict pragma */ #define HINT_STRICT_VARS 0x00000400 /* strict pragma */ +#define HINT_UNI_8_BIT 0x00000800 /* unicode8bit pragma */ /* The HINT_NEW_* constants are used by the overload pragma */ #define HINT_NEW_INTEGER 0x00001000 @@ -4257,7 +4686,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 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 */ @@ -4265,9 +4695,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 +#define HINT_NO_AMAGIC 0x01000000 /* overloading pragma */ /* The following are stored in $^H{sort}, not in PL_hints */ #define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */ @@ -4303,14 +4731,15 @@ 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*); -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 *); @@ -4324,6 +4753,12 @@ typedef void (*XSUBADDR_t) (pTHX_ CV *); typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); +typedef void(CPERLscope(*Perl_ophook_t))(pTHX_ OP*); +typedef int (CPERLscope(*Perl_keyword_plugin_t))(pTHX_ char*, STRLEN, OP**); + +#define KEYWORD_PLUGIN_DECLINE 0 +#define KEYWORD_PLUGIN_STMT 1 +#define KEYWORD_PLUGIN_EXPR 2 /* Interpreter exitlist entry */ typedef struct exitlistentry { @@ -4341,6 +4776,14 @@ typedef struct exitlistentry { # define FAKE_DEFAULT_SIGNAL_HANDLERS #endif +#define PERL_PATCHLEVEL_H_IMPLICIT +#include "patchlevel.h" +#undef PERL_PATCHLEVEL_H_IMPLICIT + +#define PERL_VERSION_STRING STRINGIFY(PERL_REVISION) "." \ + STRINGIFY(PERL_VERSION) "." \ + STRINGIFY(PERL_SUBVERSION) + #ifdef PERL_GLOBAL_STRUCT struct perl_vars { # include "perlvars.h" @@ -4371,13 +4814,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 @@ -4386,8 +4823,6 @@ struct interpreter { }; #endif /* MULTIPLICITY */ -typedef void *Thread; - /* Done with PERLVAR macros for now ... */ #undef PERLVAR #undef PERLVARA @@ -4401,7 +4836,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 @@ -4439,10 +4878,14 @@ struct tempsym; /* defined in pp_pack.c */ #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" @@ -4486,66 +4929,70 @@ START_EXTERN_C # 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 */ 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 @@ -4553,444 +5000,367 @@ 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, - 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 ); +MGVTBL_SET( + PL_vtbl_hints, + 0, + 0, + 0, + MEMBER_TO_FPTR(Perl_magic_clearhints), + 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; @@ -5044,8 +5414,9 @@ typedef struct am_table_short AMTS; #define PERLDB_ALL (PERLDBf_SUB | PERLDBf_LINE | \ PERLDBf_NOOPT | PERLDBf_INTER | \ PERLDBf_SUBLINE| PERLDBf_SINGLE| \ - PERLDBf_NAMEEVAL| PERLDBf_NAMEANON ) - /* No _NONAME, _GOTO, _ASSERTION */ + PERLDBf_NAMEEVAL| PERLDBf_NAMEANON | \ + PERLDBf_SAVESRC) + /* No _NONAME, _GOTO */ #define PERLDBf_SUB 0x01 /* Debug sub enter/exit */ #define PERLDBf_LINE 0x02 /* Keep line # */ #define PERLDBf_NOOPT 0x04 /* Switch off optimizations */ @@ -5057,7 +5428,9 @@ 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 PERLDBf_SAVESRC 0x400 /* Save source lines into @{"_<$filename"} */ +#define PERLDBf_SAVESRC_NOSUBS 0x800 /* Including evals that generate no subrouties */ +#define PERLDBf_SAVESRC_INVALID 0x1000 /* Save source that did not compile */ #define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB)) #define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE)) @@ -5069,7 +5442,9 @@ typedef struct am_table_short AMTS; #define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO)) #define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL)) #define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON)) -#define PERLDB_ASSERTION (PL_perldb && (PL_perldb & PERLDBf_ASSERTION)) +#define PERLDB_SAVESRC (PL_perldb && (PL_perldb & PERLDBf_SAVESRC)) +#define PERLDB_SAVESRC_NOSUBS (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS)) +#define PERLDB_SAVESRC_INVALID (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID)) #ifdef USE_LOCALE_NUMERIC @@ -5264,8 +5639,9 @@ 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. @@ -5284,6 +5660,39 @@ 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) + +/* 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 \ + +#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. */ @@ -5312,6 +5721,8 @@ typedef struct am_table_short AMTS; 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 MY_CXT (*my_cxtp) @@ -5330,6 +5741,7 @@ typedef struct am_table_short AMTS; #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 @@ -5378,9 +5790,10 @@ int flock(int fd, int op); #if O_TEXT != O_BINARY /* If you have different O_TEXT and O_BINARY and you are a CLRF shop, * that is, you are somehow DOSish. */ -# if defined(__BEOS__) || defined(__VOS__) || defined(__CYGWIN__) - /* BeOS has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect; - * BeOS is always UNIXoid (LF), not DOSish (CRLF). */ +# if defined(__BEOS__) || defined(__HAIKU__) || defined(__VOS__) || \ + defined(__CYGWIN__) + /* BeOS/Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect; + * BeOS/Haiku is always UNIXoid (LF), not DOSish (CRLF). */ /* VOS has O_TEXT != O_BINARY, and they have effect, * but VOS always uses LF, never CRLF. */ /* If you have O_TEXT different from your O_BINARY but you still are @@ -5392,70 +5805,12 @@ int flock(int fd, int op); # endif #endif -#ifdef IAMSUID - -#ifdef I_SYS_STATVFS -# if defined(PERL_SCO) && !defined(_SVID3) -# define _SVID3 -# endif -# include /* for f?statvfs() */ -#endif -#ifdef I_SYS_MOUNT -# include /* for *BSD f?statfs() */ -#endif -#ifdef I_MNTENT -# include /* for getmntent() */ -#endif -#ifdef I_SYS_STATFS -# include /* for some statfs() */ -#endif -#ifdef I_SYS_VFS -# ifdef __sgi -# define sv IRIX_sv /* kludge: IRIX has an sv of its own */ -# endif -# include /* for some statfs() */ -# ifdef __sgi -# undef IRIX_sv -# endif -#endif -#ifdef I_USTAT -# include /* for ustat() */ -#endif - -#if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID) -# define PERL_MOUNT_NOSUID MOUNT_NOSUID -#endif -#if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID) -# define PERL_MOUNT_NOSUID MNT_NOSUID -#endif -#if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID) -# define PERL_MOUNT_NOSUID MS_NOSUID -#endif -#if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID) -# define PERL_MOUNT_NOSUID M_NOSUID -#endif - -#if !defined(PERL_MOUNT_NOEXEC) && defined(MOUNT_NOEXEC) -# define PERL_MOUNT_NOEXEC MOUNT_NOEXEC -#endif -#if !defined(PERL_MOUNT_NOEXEC) && defined(MNT_NOEXEC) -# define PERL_MOUNT_NOEXEC MNT_NOEXEC -#endif -#if !defined(PERL_MOUNT_NOEXEC) && defined(MS_NOEXEC) -# define PERL_MOUNT_NOEXEC MS_NOEXEC -#endif -#if !defined(PERL_MOUNT_NOEXEC) && defined(M_NOEXEC) -# define PERL_MOUNT_NOEXEC M_NOEXEC -#endif - -#endif /* IAMSUID */ - #ifdef I_LIBUTIL # include /* setproctitle() in some FreeBSDs */ #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 @@ -5615,11 +5970,6 @@ extern void moncontrol(int); #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 @@ -5630,8 +5980,7 @@ extern void moncontrol(int); #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 @@ -5642,10 +5991,13 @@ extern void moncontrol(int); #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_ELIPSES|PERL_PV_PRETTY_QUOTE -#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_LTGT +#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 /* @@ -5699,3 +6051,14 @@ extern void moncontrol(int); #endif /* Include guard */ +#define CLEAR_ERRSV() STMT_START { sv_setpvn(ERRSV,"",0); if (SvMAGICAL(ERRSV)) { mg_free(ERRSV); } SvPOK_only(ERRSV); } STMT_END + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */