X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=f4d20f8b41928cc5e6a5c359c3b17b1878d39a93;hb=0ad39044976812f3d7577556791797d57eb65d61;hp=d6ccfa470a221bf428e1d3ecfaadc33c9a1e10b6;hpb=6ac6a52b90121db9304782c76ae9243ce4205369;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index d6ccfa4..f4d20f8 100644 --- a/perl.h +++ b/perl.h @@ -1,7 +1,7 @@ /* perl.h * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 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. @@ -59,23 +59,24 @@ # endif #endif -#if defined(MULTIPLICITY) -# ifndef PERL_IMPLICIT_CONTEXT -# define PERL_IMPLICIT_CONTEXT -# endif -#endif - #ifdef PERL_GLOBAL_STRUCT_PRIVATE # ifndef PERL_GLOBAL_STRUCT # define PERL_GLOBAL_STRUCT # endif #endif + #ifdef PERL_GLOBAL_STRUCT # ifndef MULTIPLICITY # define MULTIPLICITY # endif #endif +#ifdef MULTIPLICITY +# ifndef PERL_IMPLICIT_CONTEXT +# define PERL_IMPLICIT_CONTEXT +# endif +#endif + /* undef WIN32 when building on Cygwin (for libwin32) - gph */ #ifdef __CYGWIN__ # undef WIN32 @@ -148,12 +149,13 @@ # ifndef MULTIPLICITY # define MULTIPLICITY # endif -# define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL +# define tTHX PerlInterpreter* +# define pTHX register tTHX my_perl PERL_UNUSED_DECL # define aTHX my_perl # ifdef PERL_GLOBAL_STRUCT -# define dTHXa(a) dVAR; pTHX = (PerlInterpreter*)a +# define dTHXa(a) dVAR; pTHX = (tTHX)a # else -# define dTHXa(a) pTHX = (PerlInterpreter*)a +# define dTHXa(a) pTHX = (tTHX)a # endif # ifdef PERL_GLOBAL_STRUCT # define dTHX dVAR; pTHX = PERL_GET_THX @@ -171,6 +173,11 @@ # define pTHX_7 8 # define pTHX_8 9 # define pTHX_9 10 +# if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL) +# define PERL_TRACK_MEMPOOL +# endif +#else +# undef PERL_TRACK_MEMPOOL #endif #define STATIC static @@ -231,6 +238,9 @@ #define dNOOP extern int Perl___notused PERL_UNUSED_DECL #ifndef pTHX +/* Don't bother defining tTHX and sTHX; using them outside + * code guarded by PERL_IMPLICIT_CONTEXT is an error. + */ # define pTHX void # define pTHX_ # define aTHX @@ -815,6 +825,14 @@ int usleep(unsigned int); #define PERL_DONT_CREATE_GVSV #endif +#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME) +#define PERL_USES_PL_PIDSTATUS +#endif + +#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL) +#define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION +#endif + /* Cannot include embed.h here on Win32 as win32.h has not yet been included and defines some config variables e.g. HAVE_INTERP_INTERN */ @@ -2562,7 +2580,7 @@ typedef pthread_key_t perl_key; # define STATUS_NATIVE PL_statusvalue_vms /* * vaxc$errno is only guaranteed to be valid if errno == EVMSERR, otherwise - * it's contents can not be trusted. Unfortunately, Perl seems to check + * its contents can not be trusted. Unfortunately, Perl seems to check * it on exit, so it when PL_statusvalue_vms is updated, vaxc$errno should * be updated also. */ @@ -2687,7 +2705,7 @@ typedef pthread_key_t perl_key; if (MY_POSIX_EXIT) \ PL_statusvalue_vms = \ (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \ - (STS$K_ERROR | STS$M_INHIB_MSG) : 0); \ + (STS$K_ERROR | STS$M_INHIB_MSG) : 1); \ else \ PL_statusvalue_vms = SS$_ABORT; \ } else { /* forgive them Perl, for they have sinned */ \ @@ -2722,7 +2740,7 @@ typedef pthread_key_t perl_key; if (MY_POSIX_EXIT) \ PL_statusvalue_vms = \ (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \ - (STS$K_ERROR | STS$M_INHIB_MSG) : 0); \ + (STS$K_ERROR | STS$M_INHIB_MSG) : 1); \ else \ PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \ set_vaxc_errno(PL_statusvalue_vms); \ @@ -2955,11 +2973,16 @@ typedef pthread_key_t perl_key; #ifndef IOCPARM_LEN # ifdef IOCPARM_MASK - /* on BSDish systes we're safe */ + /* on BSDish systems we're safe */ # define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) # else +# if defined(_IOC_SIZE) && defined(__GLIBC__) + /* on Linux systems we're safe; except when we're not [perl #38223] */ +# define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x)) +# else /* otherwise guess at what's safe */ -# define IOCPARM_LEN(x) 256 +# define IOCPARM_LEN(x) 256 +# endif # endif #endif @@ -3480,7 +3503,7 @@ Gid_t getegid (void); #ifndef assert /* might have been included somehow */ #define assert(what) PERL_DEB( \ ((what) ? ((void) 0) : \ - (Perl_croak(aTHX_ "Assertion %s failed: file \"" __FILE__ \ + (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \ "\", line %d", STRINGIFY(what), __LINE__), \ PerlProc_exit(1), \ (void) 0))) @@ -3704,6 +3727,24 @@ typedef Sighandler_t Sigsave_t; # define MALLOC_TERM #endif +#if defined(PERL_IMPLICIT_CONTEXT) +struct perl_memory_debug_header { + tTHX interpreter; +# ifdef PERL_POISON + MEM_SIZE size; + U8 in_use; +# endif + +#define PERL_POISON_INUSE 29 +#define PERL_POISON_FREE 159 +}; + +# define sTHX (sizeof(struct perl_memory_debug_header) + \ + (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \ + %MEM_ALIGNBYTES) % MEM_ALIGNBYTES) + +#endif + typedef int (CPERLscope(*runops_proc_t)) (pTHX); typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv); @@ -3777,10 +3818,8 @@ EXTCONST char PL_no_myglob[] INIT("\"my\" variable %s can't be in a package"); EXTCONST char PL_no_localize_ref[] INIT("Can't localize through a reference"); -#ifdef PERL_MALLOC_WRAP EXTCONST char PL_memory_wrap[] INIT("panic: memory wrap"); -#endif EXTCONST char PL_uuemap[65] INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); @@ -3998,6 +4037,9 @@ EXTCONST char* const PL_block_type[] = { "LOOP", "SUBST", "BLOCK", + "FORMAT", + "GIVEN", + "WHEN" }; #else EXTCONST char* PL_block_type[]; @@ -4302,11 +4344,11 @@ END_EXTERN_C START_EXTERN_C #ifdef DOINIT -# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {a,b,c,d,e,f,g} -# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g} /* Like MGVTBL_SET but with the get magic having a const MG* */ +# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXT MGVTBL var = {a,b,c,d,e,f,g} +# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXT MGVTBL var = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g} /* Like MGVTBL_SET but with the get magic having a const MG* */ #else -# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var -# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var +# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXT MGVTBL var +# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXT MGVTBL var #endif MGVTBL_SET( @@ -4704,7 +4746,10 @@ enum { to_sv_amg, to_av_amg, to_hv_amg, to_gv_amg, to_cv_amg, iter_amg, - int_amg, DESTROY_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. */ }; @@ -4751,7 +4796,8 @@ EXTCONST char * const PL_AMG_names[NofAMmeth] = { "(${}", "(@{}", "(%{}", "(*{}", "(&{}", "(<>", - "(int", "DESTROY", + "(int", "(~~", + "DESTROY" }; #else EXTCONST char * PL_AMG_names[NofAMmeth]; @@ -5049,6 +5095,7 @@ typedef struct am_table_short AMTS; * Code that uses these macros is responsible for the following: * 1. #define MY_CXT_KEY to a unique string, e.g. * "DynaLoader::_guts" XS_VERSION + * XXX in the current implementation, this string is ignored. * 2. Declare a typedef named my_cxt_t that is a structure that contains * all the data that needs to be interpreter-local. * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. @@ -5065,35 +5112,30 @@ typedef struct am_table_short AMTS; /* 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 - -/* Fetches the SV that keeps the per-interpreter data. */ -#define dMY_CXT_SV \ - SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ - sizeof(MY_CXT_KEY)-1, TRUE) +#define START_MY_CXT static int my_cxt_index = -1; /* This declaration should be used within all functions that use the * interpreter-local data. */ #define dMY_CXT \ - dMY_CXT_SV; \ - my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)) + my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[my_cxt_index] +#define dMY_CXT_INTERP(my_perl) \ + my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[my_cxt_index] /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when * the interpreter goes away.) */ #define MY_CXT_INIT \ - dMY_CXT_SV; \ - /* newSV() allocates one more than needed */ \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - Zero(my_cxtp, 1, my_cxt_t); \ - sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + my_cxt_t *my_cxtp = \ + (my_cxt_t*)Perl_my_cxt_init(aTHX_ &my_cxt_index, sizeof(my_cxt_t)) +#define MY_CXT_INIT_INTERP(my_perl) \ + my_cxt_t *my_cxtp = \ + (my_cxt_t*)Perl_my_cxt_init(my_perl, &my_cxt_index, sizeof(my_cxt_t)) /* Clones the per-interpreter data. */ #define MY_CXT_CLONE \ - dMY_CXT_SV; \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ - sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + Copy(PL_my_cxt_list[my_cxt_index], my_cxtp, 1, my_cxt_t);\ + PL_my_cxt_list[my_cxt_index] = my_cxtp \ /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ @@ -5108,7 +5150,7 @@ typedef struct am_table_short AMTS; #define aMY_CXT_ aMY_CXT, #define _aMY_CXT ,aMY_CXT -#else /* USE_ITHREADS */ +#else /* PERL_IMPLICIT_CONTEXT */ #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP @@ -5124,7 +5166,7 @@ typedef struct am_table_short AMTS; #define aMY_CXT_ #define _aMY_CXT -#endif /* !defined(USE_ITHREADS) */ +#endif /* !defined(PERL_IMPLICIT_CONTEXT) */ #ifdef I_FCNTL # include @@ -5381,6 +5423,17 @@ extern void moncontrol(int); #pragma message disable (mainparm) /* Perl uses the envp in main(). */ #endif +#define do_open(g, n, l, a, rm, rp, sf) \ + do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0) +#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION +# define do_exec(cmd) do_exec3(cmd,0,0) +#endif +#ifdef OS2 +# define do_aexec Perl_do_aexec +#else +# define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0) +#endif + /* and finally... */ #define PERL_PATCHLEVEL_H_IMPLICIT #include "patchlevel.h"