X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f1b875a0a91038690cebe55acd7ad1e37e6a2621..ce0e211a90da72f1344099dc2e538e0b466a3641:/perl.h diff --git a/perl.h b/perl.h index d59ac35..c6008bb 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, 2007, by Larry Wall and others + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 + * 2002, 2003, 2004, 2005, 2006, 2007, 2008 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. @@ -41,6 +41,24 @@ # endif #endif +/* This logic needs to come after reading config.h, but before including + proto.h */ +#ifdef IAMSUID +# ifndef DOSUID +# define DOSUID +# endif +#endif + +#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW +# ifdef DOSUID +# undef DOSUID +# endif +# ifdef IAMSUID +# undef IAMSUID +# define SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID +# endif +#endif + /* See L for detailed notes on * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */ @@ -201,72 +219,68 @@ #define CALLREGCOMP_ENG(prog, sv, flags) \ CALL_FPTR(((prog)->comp))(aTHX_ sv, flags) #define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \ - CALL_FPTR((prog)->engine->exec)(aTHX_ (prog),(stringarg),(strend), \ + CALL_FPTR(RX_ENGINE(prog)->exec)(aTHX_ (prog),(stringarg),(strend), \ (strbeg),(minend),(screamer),(data),(flags)) #define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \ - CALL_FPTR((prog)->engine->intuit)(aTHX_ (prog), (sv), (strpos), \ + CALL_FPTR(RX_ENGINE(prog)->intuit)(aTHX_ (prog), (sv), (strpos), \ (strend),(flags),(data)) #define CALLREG_INTUIT_STRING(prog) \ - CALL_FPTR((prog)->engine->checkstr)(aTHX_ (prog)) - -#define CALLREG_AS_STR(mg,lp,flags,haseval) \ - Perl_reg_stringify(aTHX_ (mg), (lp), (flags), (haseval)) -#define CALLREG_STRINGIFY(mg,lp,flags) CALLREG_AS_STR(mg,lp,flags,0) + CALL_FPTR(RX_ENGINE(prog)->checkstr)(aTHX_ (prog)) #define CALLREGFREE(prog) \ Perl_pregfree(aTHX_ (prog)) #define CALLREGFREE_PVT(prog) \ - if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog)) + if(prog) CALL_FPTR(RX_ENGINE(prog)->free)(aTHX_ (prog)) #define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \ - CALL_FPTR((rx)->engine->numbered_buff_FETCH)(aTHX_ (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->numbered_buff_STORE)(aTHX_ (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->numbered_buff_LENGTH)(aTHX_ (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->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH)) + 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->named_buff)(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE)) + 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->named_buff)(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE)) + 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->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR)) + 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->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS)) + 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->named_buff_iter)(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY)) + 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->named_buff_iter)(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY)) + 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->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR)) + CALL_FPTR(RX_ENGINE(rx)->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) + 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->named_buff)(aTHX_ (rx), NULL, NULL, flags) + CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, flags) #define CALLREG_PACKAGE(rx) \ - CALL_FPTR((rx)->engine->qr_package)(aTHX_ (rx)) + CALL_FPTR(RX_ENGINE(rx)->qr_package)(aTHX_ (rx)) #if defined(USE_ITHREADS) #define CALLREGDUPE(prog,param) \ Perl_re_dup(aTHX_ (prog),(param)) #define CALLREGDUPE_PVT(prog,param) \ - (prog ? CALL_FPTR((prog)->engine->dupe)(aTHX_ (prog),(param)) \ + (prog ? CALL_FPTR(RX_ENGINE(prog)->dupe)(aTHX_ (prog),(param)) \ : (REGEXP *)NULL) #endif @@ -434,8 +448,12 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); /* 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 @@ -510,11 +528,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 @@ -663,6 +677,11 @@ 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 @@ -923,6 +942,11 @@ EXTERN_C 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. @@ -1258,6 +1282,11 @@ EXTERN_C char *crypt(const char *, const char *); 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 @@ -1272,6 +1301,11 @@ EXTERN_C char *crypt(const char *, const char *); # 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 @@ -1287,8 +1321,12 @@ EXTERN_C char *crypt(const char *, const char *); #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 */ @@ -1520,15 +1558,15 @@ EXTERN_C char *crypt(const char *, const char *); # 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 @@ -2352,7 +2390,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; @@ -2551,7 +2590,10 @@ typedef struct clone_params CLONE_PARAMS; # 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 @@ -2631,7 +2673,11 @@ 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) @@ -2648,10 +2694,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 @@ -2695,7 +2745,11 @@ 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__ @@ -2724,6 +2778,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 @@ -2904,9 +2959,9 @@ typedef pthread_key_t perl_key; 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); \ + 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 */ \ @@ -2932,6 +2987,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) \ @@ -2939,9 +2997,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); \ @@ -3068,12 +3127,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_ @@ -3094,27 +3150,27 @@ typedef pthread_key_t perl_key; #define SVfARG(p) ((void*)(p)) -#ifndef vdNUMBER -# define vdNUMBER 1 -#endif - -#ifndef VDf -# if vdNUMBER -# define VDf STRINGIFY(vdNUMBER) "p" -# else +#ifdef PERL_CORE +/* not used; but needed for backward compatibilty with XS code? - RMB */ +# undef VDf +#else +# ifndef VDf # define VDf "vd" # endif #endif #ifdef PERL_CORE /* not used; but needed for backward compatibilty with XS code? - RMB */ +# undef UVf +#else # ifndef UVf # define UVf UVuf # endif -#else -# undef UVf #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 @@ -3138,6 +3194,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 @@ -3308,8 +3367,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" @@ -3325,6 +3395,11 @@ struct nexttoken { #include "warnings.h" #include "utf8.h" +/* defined in sv.c, but also used in [ach]v.c */ +#undef _XPV_ALLOCATED_HEAD +#undef _XPV_HEAD +#undef _XPVMG_HEAD +#undef _XPVCV_COMMON typedef struct _sublex_info SUBLEXINFO; struct _sublex_info { @@ -3525,7 +3600,7 @@ Gid_t getegid (void); #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 */ @@ -3533,7 +3608,7 @@ 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_MASK 0x00FEEFFF /* mask of all the standard flags */ #define DEBUG_DB_RECURSE_FLAG 0x40000000 #define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal @@ -3555,7 +3630,6 @@ Gid_t getegid (void); # 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) @@ -3564,6 +3638,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 @@ -3582,9 +3657,7 @@ Gid_t getegid (void); # 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_ @@ -3592,6 +3665,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 @@ -3626,10 +3701,9 @@ Gid_t getegid (void); # 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) @@ -3655,9 +3729,7 @@ Gid_t getegid (void); # 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) @@ -3665,6 +3737,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) @@ -3683,15 +3757,15 @@ Gid_t getegid (void); # define DEBUG_U(a) # define DEBUG_H(a) # define DEBUG_X(a) -# define DEBUG_Xv(a) # define DEBUG_D(a) -# define DEBUG_S(a) # define DEBUG_T(a) # define DEBUG_R(a) # define DEBUG_v(a) # define DEBUG_C(a) # define DEBUG_A(a) # define DEBUG_q(a) +# define DEBUG_Xv(a) +# define DEBUG_Uv(a) #endif /* DEBUGGING */ @@ -3755,13 +3829,21 @@ Gid_t getegid (void); #define PERL_MAGIC_arylen_p '@' /* to move arylen out of XPVAV */ #define PERL_MAGIC_ext '~' /* Available for use by extensions */ +#if defined(DEBUGGING) && defined(I_ASSERT) +# include +#endif + +/* Keep the old croak based assert for those who want it, and as a fallback if + the platform is so heretically non-ANSI that it can't assert. */ -#ifndef assert /* might have been included somehow */ -#define assert(what) PERL_DEB( \ +#define Perl_assert(what) PERL_DEB( \ ((what) ? ((void) 0) : \ (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \ "\", line %d", STRINGIFY(what), __LINE__), \ (void) 0))) + +#ifndef assert +# define assert(what) Perl_assert(what) #endif struct ufuncs { @@ -3961,17 +4043,17 @@ typedef Sighandler_t Sigsave_t; #endif #ifdef USE_PERLIO -EXTERN_C void PerlIO_teardown(pTHX); +EXTERN_C void PerlIO_teardown(void); # ifdef USE_ITHREADS # define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex) # define PERLIO_TERM \ STMT_START { \ - PerlIO_teardown(aTHX); \ + PerlIO_teardown(); \ MUTEX_DESTROY(&PL_perlio_mutex);\ } STMT_END # else # define PERLIO_INIT -# define PERLIO_TERM PerlIO_teardown(aTHX) +# define PERLIO_TERM PerlIO_teardown() # endif #else # define PERLIO_INIT @@ -4016,6 +4098,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 @@ -4028,11 +4112,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!@" @@ -4104,6 +4217,12 @@ 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[\\]^_"); @@ -4318,20 +4437,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 /*****************************************************************************/ @@ -4473,8 +4700,8 @@ typedef regexp*(CPERLscope(*regdupe_t)) (pTHX_ const regexp* r, CLONE_PARAMS *pa 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 *); @@ -4505,6 +4732,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" @@ -4602,6 +4833,11 @@ START_EXTERN_C 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" @@ -4767,8 +5003,8 @@ MGVTBL_SET( 0, MEMBER_TO_FPTR(Perl_magic_setisa), 0, - MEMBER_TO_FPTR(Perl_magic_setisa), - MEMBER_TO_FPTR(Perl_magic_freeisa), + MEMBER_TO_FPTR(Perl_magic_clearisa), + 0, 0, 0, 0 @@ -4885,7 +5121,7 @@ MGVTBL_SET( MGVTBL_SET( PL_vtbl_bm, 0, - MEMBER_TO_FPTR(Perl_magic_setbm), + MEMBER_TO_FPTR(Perl_magic_setregexp), 0, 0, 0, @@ -4897,7 +5133,7 @@ MGVTBL_SET( MGVTBL_SET( PL_vtbl_fm, 0, - MEMBER_TO_FPTR(Perl_magic_setfm), + MEMBER_TO_FPTR(Perl_magic_setregexp), 0, 0, 0, @@ -4936,7 +5172,7 @@ MGVTBL_SET( MEMBER_TO_FPTR(Perl_magic_setregexp), 0, 0, - MEMBER_TO_FPTR(Perl_magic_freeregexp), + 0, 0, 0, 0 @@ -5119,8 +5355,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 */ @@ -5132,6 +5369,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_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)) @@ -5143,7 +5383,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 @@ -5440,6 +5682,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 @@ -5488,9 +5731,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 @@ -5565,7 +5809,7 @@ int flock(int fd, int op); #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 @@ -5725,11 +5969,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 @@ -5740,8 +5979,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 @@ -5754,9 +5992,11 @@ extern void moncontrol(int); #define PERL_PV_ESCAPE_NOCLEAR 0x4000 #define PERL_PV_ESCAPE_RE 0x8000 +#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR + /* used by pv_display in dump.c*/ -#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_QUOTE -#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE +#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE +#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE /* @@ -5810,3 +6050,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: + */