X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=bb6437d8e79b58a7439d55eb47a04a0d4510c8aa;hb=fa36c1f0228e069bbe2ce9deb846c72334bb6f27;hp=4f39f412e76b05fd429e8a8115edf2fbdd2824cf;hpb=b1e55cab83fc5b3a567d95fba8bca0592334b7a5;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 4f39f41..bb6437d 100644 --- a/perl.h +++ b/perl.h @@ -195,11 +195,26 @@ #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(exp, xend, pm) Perl_pregcomp(aTHX_ exp,xend,pm) + +#define CALLREGCOMP_ENG(prog, exp, xend, pm) \ + CALL_FPTR(((prog)->comp))(aTHX_ exp, xend, pm) +#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \ + CALL_FPTR((prog)->engine->exec)(aTHX_ (prog),(stringarg),(strend), \ + (strbeg),(minend),(screamer),(data),(flags)) +#define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \ + CALL_FPTR((prog)->engine->intuit)(aTHX_ (prog), (sv), (strpos), \ + (strend),(flags),(data)) +#define CALLREG_INTUIT_STRING(prog) \ + CALL_FPTR((prog)->engine->checkstr)(aTHX_ (prog)) +#define CALLREGFREE(prog) \ + if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog)) +#if defined(USE_ITHREADS) +#define CALLREGDUPE(prog,param) \ + (prog ? CALL_FPTR((prog)->engine->dupe)(aTHX_ (prog),(param)) \ + : (REGEXP *)NULL) +#endif /* * Because of backward compatibility reasons the PERL_UNUSED_DECL @@ -337,10 +352,18 @@ * PERL_CALLCONV to be something special. See also the * definition of XS() in XSUB.h. */ #ifndef PERL_EXPORT_C -# define PERL_EXPORT_C extern +# ifdef __cplusplus +# define PERL_EXPORT_C extern "C" +# else +# define PERL_EXPORT_C extern +# endif #endif #ifndef PERL_XS_EXPORT_C -# define PERL_XS_EXPORT_C +# ifdef __cplusplus +# define PERL_XS_EXPORT_C extern "C" +# else +# define PERL_XS_EXPORT_C +# endif #endif #ifdef OP_IN_REGISTER @@ -587,11 +610,11 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #endif #if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO) -int syscall(int, ...); +EXTERN_C int syscall(int, ...); #endif #if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO) && !defined(PERL_MICRO) -int usleep(unsigned int); +EXTERN_C int usleep(unsigned int); #endif #ifdef PERL_MICRO /* Last chance to export Perl_my_swap */ @@ -1142,6 +1165,18 @@ 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 + #ifdef SETERRNO # undef SETERRNO /* SOCKS might have defined this */ #endif @@ -1471,9 +1506,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 +1518,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__) @@ -3000,6 +3035,7 @@ typedef pthread_key_t perl_key; # endif #endif +/* not used; but needed for backward compatibilty with XS code? - RMB */ #ifndef UVf # define UVf UVuf #endif @@ -3384,7 +3420,8 @@ Gid_t getegid (void); #define DEBUG_r_FLAG 0x00000200 /* 512 */ #define DEBUG_x_FLAG 0x00000400 /* 1024 */ #define DEBUG_u_FLAG 0x00000800 /* 2048 */ - /* spare */ +/* U is reserved for Unofficial, exploratory hacking */ +#define DEBUG_U_FLAG 0x00001000 /* 4096 */ #define DEBUG_H_FLAG 0x00002000 /* 8192 */ #define DEBUG_X_FLAG 0x00004000 /* 16384 */ #define DEBUG_D_FLAG 0x00008000 /* 32768 */ @@ -3414,6 +3451,7 @@ Gid_t getegid (void); # define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG) # define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG) # define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG) +# define DEBUG_U_TEST_ (PL_debug & DEBUG_U_FLAG) # define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG) # define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG) # define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG) @@ -3441,6 +3479,7 @@ 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_ @@ -3477,9 +3516,14 @@ 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) @@ -3508,6 +3552,7 @@ 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) @@ -3535,6 +3580,7 @@ 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) @@ -3569,6 +3615,8 @@ Gid_t getegid (void); #define PERL_MAGIC_overload_elem 'a' /* %OVERLOAD hash element */ #define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */ #define PERL_MAGIC_bm 'B' /* Boyer-Moore (fast string search) */ +#define PERL_MAGIC_regdata_names '+' /* Regex named capture buffer hash + (%+ support) */ #define PERL_MAGIC_regdata 'D' /* Regex match position data (@+ and @- vars) */ #define PERL_MAGIC_regdatum 'd' /* Regex match position data element */ @@ -3815,6 +3863,21 @@ typedef Sighandler_t Sigsave_t; # define RUNOPS_DEFAULT Perl_runops_standard #endif +#ifdef USE_PERLIO +void PerlIO_teardown(pTHX); +# ifdef USE_THREADS +# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex) +# define PERLIO_TERM \ + STMT_START { \ + PerlIO_teardown(aTHX); \ + MUTEX_DESTROY(&PL_perlio_mutex);\ + } STMT_END +# else +# define PERLIO_INIT +# define PERLIO_TERM PerlIO_teardown(aTHX) +# endif +#endif + #ifdef MYMALLOC # ifdef MUTEX_INIT_CALLS_MALLOC # define MALLOC_INIT \ @@ -3921,7 +3984,7 @@ EXTCONST char PL_no_usym[] EXTCONST char PL_no_aelem[] INIT("Modification of non-creatable array value attempted, subscript %d"); EXTCONST char PL_no_helem_sv[] - INIT("Modification of non-creatable hash value attempted, subscript \""SVf"\""); + INIT("Modification of non-creatable hash value attempted, subscript \"%"SVf"\""); EXTCONST char PL_no_modify[] INIT("Modification of a read-only value attempted"); EXTCONST char PL_no_mem[] @@ -4265,9 +4328,9 @@ 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 +/* assertions pragma, stored in $^H{assertions} */ +#define HINT_ASSERTING 0x00000001 +#define HINT_ASSERTIONSSEEN 0x00000002 /* The following are stored in $^H{sort}, not in PL_hints */ #define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */ @@ -4306,6 +4369,7 @@ typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv, struct re_scream_pos_data_s *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*); @@ -4401,7 +4465,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 @@ -4779,6 +4847,18 @@ MGVTBL_SET( ); MGVTBL_SET( + PL_vtbl_regdata_names, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( PL_vtbl_regdata, NULL, NULL, @@ -4887,110 +4967,21 @@ MGVTBL_SET( NULL ); - -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; }; 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; @@ -5620,7 +5611,38 @@ extern void moncontrol(int); #include "patchlevel.h" #undef PERL_PATCHLEVEL_H_IMPLICIT -/* Mention +/* These are used by Perl_pv_escape() and Perl_pv_pretty() + * are here so that they are available throughout the core + * NOTE that even though some are for _escape and some for _pretty + * there must not be any clashes as the flags from _pretty are + * passed straight through to _escape. + */ + +#define PERL_PV_ESCAPE_QUOTE 0x0001 +#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE + + +#define PERL_PV_PRETTY_ELIPSES 0x0002 +#define PERL_PV_PRETTY_LTGT 0x0004 + +#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008 + +#define PERL_PV_ESCAPE_UNI 0x0100 +#define PERL_PV_ESCAPE_UNI_DETECT 0x0200 + +#define PERL_PV_ESCAPE_ALL 0x1000 +#define PERL_PV_ESCAPE_NOBACKSLASH 0x2000 +#define PERL_PV_ESCAPE_NOCLEAR 0x4000 + +/* 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 + +/* + + (KEEP THIS LAST IN perl.h!) + + Mention NV_PRESERVES_UV @@ -5660,34 +5682,11 @@ extern void moncontrol(int); HAS_DIRFD - so that Configure picks them up. */ + so that Configure picks them up. -/* These are used by Perl_pv_escape() and Perl_pv_pretty() - * are here so that they are available throughout the core - * NOTE that even though some are for _escape and some for _pretty - * there must not be any clashes as the flags from _pretty are - * passed straight through to _escape. - */ - -#define PERL_PV_ESCAPE_QUOTE 0x0001 -#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE - - -#define PERL_PV_PRETTY_ELIPSES 0x0002 -#define PERL_PV_PRETTY_LTGT 0x0004 - -#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008 - -#define PERL_PV_ESCAPE_UNI 0x0100 -#define PERL_PV_ESCAPE_UNI_DETECT 0x0200 - -#define PERL_PV_ESCAPE_ALL 0x1000 -#define PERL_PV_ESCAPE_NOBACKSLASH 0x2000 -#define PERL_PV_ESCAPE_NOCLEAR 0x4000 + (KEEP THIS LAST IN perl.h!) -/* 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 +*/ #endif /* Include guard */