X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=39414e729f47a52df7213633ef301528eda48be2;hb=b8082b6e76ddae55d59bd06493f5cb60a320b165;hp=e379cc31c656d3bb6a2acb4f20bb6303bbf390ab;hpb=9568a12365eb8ff5d5bc470ce5480d516d924f31;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index e379cc3..39414e7 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 @@ -923,6 +937,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. @@ -2352,7 +2371,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; @@ -2631,7 +2651,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) @@ -3308,8 +3332,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 +3360,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 +3565,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 +3573,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 +3595,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) @@ -3584,7 +3623,6 @@ Gid_t getegid (void); # define DEBUG_H_TEST DEBUG_H_TEST_ # define DEBUG_X_TEST DEBUG_X_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_ @@ -3632,8 +3670,6 @@ Gid_t getegid (void); # define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a) # define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a) -# define DEBUG_S(a) - # define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a) # define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a) # define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a) @@ -3659,7 +3695,6 @@ Gid_t getegid (void); # define DEBUG_H_TEST (0) # define DEBUG_X_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) @@ -3688,7 +3723,6 @@ Gid_t getegid (void); # define DEBUG_H(a) # define DEBUG_X(a) # define DEBUG_D(a) -# define DEBUG_S(a) # define DEBUG_T(a) # define DEBUG_R(a) # define DEBUG_v(a) @@ -3760,13 +3794,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 { @@ -3966,7 +4008,7 @@ typedef Sighandler_t Sigsave_t; #endif #ifdef USE_PERLIO -EXTERN_C void PerlIO_teardown(); +EXTERN_C void PerlIO_teardown(void); # ifdef USE_ITHREADS # define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex) # define PERLIO_TERM \ @@ -4021,6 +4063,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 @@ -4033,6 +4077,34 @@ 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); @@ -4330,14 +4402,17 @@ 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[]; @@ -4590,8 +4665,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 *); @@ -4723,6 +4798,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" @@ -4888,7 +4968,7 @@ MGVTBL_SET( 0, MEMBER_TO_FPTR(Perl_magic_setisa), 0, - MEMBER_TO_FPTR(Perl_magic_setisa), + MEMBER_TO_FPTR(Perl_magic_clearisa), 0, 0, 0, @@ -5006,7 +5086,7 @@ MGVTBL_SET( MGVTBL_SET( PL_vtbl_bm, 0, - MEMBER_TO_FPTR(Perl_magic_setbm), + MEMBER_TO_FPTR(Perl_magic_setregexp), 0, 0, 0, @@ -5018,7 +5098,7 @@ MGVTBL_SET( MGVTBL_SET( PL_vtbl_fm, 0, - MEMBER_TO_FPTR(Perl_magic_setfm), + MEMBER_TO_FPTR(Perl_magic_setregexp), 0, 0, 0, @@ -5057,7 +5137,7 @@ MGVTBL_SET( MEMBER_TO_FPTR(Perl_magic_setregexp), 0, 0, - MEMBER_TO_FPTR(Perl_magic_freeregexp), + 0, 0, 0, 0 @@ -5927,3 +6007,15 @@ 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: + */