X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/486ec47ab73770ab60bf9cfb6d398a4371463266..7150f9197f27c7cc16a06b3e01391c49c78398ce:/perl.h diff --git a/perl.h b/perl.h index 9ad2172..a7cd37a 100644 --- a/perl.h +++ b/perl.h @@ -48,15 +48,6 @@ * repeated in makedef.pl, so be certain to update * both places when editing. */ -#ifdef PERL_IMPLICIT_SYS -/* PERL_IMPLICIT_SYS implies PerlMemShared != PerlMem - so use slab allocator to avoid lots of MUTEX overhead - */ -# ifndef PL_OP_SLAB_ALLOC -# define PL_OP_SLAB_ALLOC -# endif -#endif - #ifdef USE_ITHREADS # if !defined(MULTIPLICITY) # define MULTIPLICITY @@ -354,10 +345,15 @@ #endif #define NOOP /*EMPTY*/(void)0 -#if !defined(HASATTRIBUTE_UNUSED) && defined(__cplusplus) -#define dNOOP /*EMPTY*/(void)0 /* Older g++ has no __attribute((unused))__ */ +/* cea2e8a9dd23747f accidentally lost the comment originally from the first + check in of thread.h, explaining why we need dNOOP at all: */ +/* Rats: if dTHR is just blank then the subsequent ";" throws an error */ +/* Declaring a *function*, instead of a variable, ensures that we don't rely + on being able to suppress "unused" warnings. */ +#ifdef __cplusplus +#define dNOOP (void)0 #else -#define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL +#define dNOOP extern int Perl___notused(void) #endif #ifndef pTHX @@ -490,9 +486,6 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # endif #endif -#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END -#define WITH_THR(s) WITH_THX(s) - #ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */ # define BYTEORDER 0x1234 #endif @@ -541,6 +534,15 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #define TAINT_ENV() if (PL_tainting) { taint_env(); } #define TAINT_PROPER(s) if (PL_tainting) { taint_proper(NULL, s); } +/* flags used internally only within pp_subst and pp_substcont */ +#ifdef PERL_CORE +# define SUBST_TAINT_STR 1 /* string tainted */ +# define SUBST_TAINT_PAT 2 /* pattern tainted */ +# define SUBST_TAINT_REPL 4 /* replacement tainted */ +# define SUBST_TAINT_RETAINT 8 /* use re'taint' in scope */ +# define SUBST_TAINT_BOOLRET 16 /* return is boolean (don't taint) */ +#endif + /* XXX All process group stuff is handled in pp_sys.c. Should these defines move there? If so, I could simplify this a lot. --AD 9/96. */ @@ -967,17 +969,6 @@ EXTERN_C int usleep(unsigned int); #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 - */ -#if !defined(PERL_FOR_X2P) && !(defined(WIN32)||defined(VMS)) -# include "embed.h" -# ifndef PERL_MAD -# undef op_getmad -# define op_getmad(arg,pegop,slot) NOOP -# endif -#endif - #define MEM_SIZE Size_t /* Round all values passed to malloc up, by default to a multiple of @@ -1233,7 +1224,7 @@ EXTERN_C int usleep(unsigned int); # define _SOCKADDR_LEN #endif -#if defined(HAS_SOCKET) && !defined(VMS) && !defined(WIN32) /* VMS/WIN32 handle sockets via vmsish.h/win32.h */ +#if defined(HAS_SOCKET) && !defined(WIN32) /* WIN32 handles sockets via win32.h */ # include # if defined(USE_SOCKS) && defined(I_SOCKS) # if !defined(INCLUDE_PROTOTYPES) @@ -1359,11 +1350,20 @@ EXTERN_C char *crypt(const char *, const char *); #ifdef PERL_CORE # define DEFSV (0 + GvSVn(PL_defgv)) +# define DEFSV_set(sv) \ + (SvREFCNT_dec(GvSV(PL_defgv)), GvSV(PL_defgv) = SvREFCNT_inc(sv)) +# define SAVE_DEFSV \ + ( \ + save_gp(PL_defgv, 0), \ + GvINTRO_off(PL_defgv), \ + SAVEGENERICSV(GvSV(PL_defgv)), \ + GvSV(PL_defgv) = NULL \ + ) #else # define DEFSV GvSVn(PL_defgv) +# define DEFSV_set(sv) (GvSV(PL_defgv) = (sv)) +# define SAVE_DEFSV SAVESPTR(GvSV(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 */ @@ -1376,13 +1376,13 @@ EXTERN_C char *crypt(const char *, const char *); #endif #ifdef HAS_STRERROR +#ifndef DONT_DECLARE_STD # ifdef VMS char *strerror (int,...); # else -#ifndef DONT_DECLARE_STD char *strerror (int); -#endif # endif +#endif # ifndef Strerror # define Strerror strerror # endif @@ -2409,6 +2409,11 @@ typedef struct padop PADOP; typedef struct pvop PVOP; typedef struct loop LOOP; +#ifdef PERL_CORE +typedef struct opslab OPSLAB; +typedef struct opslot OPSLOT; +#endif + typedef struct block_hooks BHK; typedef struct custom_op XOP; @@ -2425,7 +2430,6 @@ typedef struct STRUCT_SV SV; typedef struct av AV; typedef struct hv HV; typedef struct cv CV; -typedef struct regexp ORANGE; /* This is the body structure. */ typedef struct p5rx REGEXP; typedef struct gp GP; typedef struct gv GV; @@ -2575,11 +2579,6 @@ typedef struct clone_params CLONE_PARAMS; #if defined(VMS) # include "vmsish.h" -# include "embed.h" -# ifndef PERL_MAD -# undef op_getmad -# define op_getmad(arg,pegop,slot) NOOP -# endif # define ISHISH "vms" #endif @@ -2609,11 +2608,6 @@ typedef struct clone_params CLONE_PARAMS; #ifdef __SYMBIAN32__ # include "symbian/symbianish.h" -# include "embed.h" -# ifndef PERL_MAD -# undef op_getmad -# define op_getmad(arg,pegop,slot) NOOP -# endif # define ISHISH "symbian" #endif @@ -2770,11 +2764,7 @@ freeing any remaining Perl interpreters. # define MAXPATHLEN (PATH_MAX+1) # endif # else -# ifdef _POSIX_PATH_MAX -# define MAXPATHLEN _POSIX_PATH_MAX -# else -# define MAXPATHLEN 1024 /* Err on the large side. */ -# endif +# define MAXPATHLEN 1024 /* Err on the large side. */ # endif #endif @@ -3202,6 +3192,18 @@ typedef pthread_key_t perl_key; #define SVfARG(p) ((void*)(p)) +#ifndef HEKf +# define HEKf "2p" +#endif + +/* Not ideal, but we cannot easily include a number in an already-numeric + * format sequence. */ +#ifndef HEKf256 +# define HEKf256 "3p" +#endif + +#define HEKfARG(p) ((void*)(p)) + #ifdef PERL_CORE /* not used; but needed for backward compatibility with XS code? - RMB */ # undef VDf @@ -3275,9 +3277,9 @@ typedef pthread_key_t perl_key; appropriate to call return. In either case, include the lint directive. */ #ifdef HASATTRIBUTE_NORETURN -# define NORETURN_FUNCTION_END /* NOTREACHED */ +# define NORETURN_FUNCTION_END assert(0); /* NOTREACHED */ #else -# define NORETURN_FUNCTION_END /* NOTREACHED */ return 0 +# define NORETURN_FUNCTION_END assert(0); /* NOTREACHED */ return 0 #endif /* Some OS warn on NULL format to printf */ @@ -3464,6 +3466,7 @@ struct _sublex_info { OP *sub_op; /* "lex_op" to use */ char *super_bufptr; /* PL_parser->bufptr that was */ char *super_bufend; /* PL_parser->bufend that was */ + char *re_eval_start;/* start of "(?{..." text */ }; #include "parser.h" @@ -3656,7 +3659,7 @@ Gid_t getegid (void); #define DEBUG_H_FLAG 0x00002000 /* 8192 */ #define DEBUG_X_FLAG 0x00004000 /* 16384 */ #define DEBUG_D_FLAG 0x00008000 /* 32768 */ -/* 0x00010000 is unused, used to be S */ +#define DEBUG_S_FLAG 0x00010000 /* 65536 */ #define DEBUG_T_FLAG 0x00020000 /* 131072 */ #define DEBUG_R_FLAG 0x00040000 /* 262144 */ #define DEBUG_J_FLAG 0x00080000 /* 524288 */ @@ -3666,7 +3669,7 @@ Gid_t getegid (void); #define DEBUG_q_FLAG 0x00800000 /*8388608 */ #define DEBUG_M_FLAG 0x01000000 /*16777216*/ #define DEBUG_B_FLAG 0x02000000 /*33554432*/ -#define DEBUG_MASK 0x03FEEFFF /* mask of all the standard flags */ +#define DEBUG_MASK 0x03FFEFFF /* mask of all the standard flags */ #define DEBUG_DB_RECURSE_FLAG 0x40000000 #define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal @@ -3688,6 +3691,7 @@ 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) @@ -3719,6 +3723,7 @@ 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_ @@ -3770,6 +3775,7 @@ Gid_t getegid (void); # define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a) # define DEBUG_Pv(a) DEBUG__(DEBUG_Pv_TEST, a) +# define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, 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) @@ -3797,6 +3803,7 @@ 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) @@ -3828,6 +3835,7 @@ 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) @@ -3848,63 +3856,6 @@ Gid_t getegid (void); where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \ __FILE__, __LINE__)); - - - -/* These constants should be used in preference to raw characters - * when using magic. Note that some perl guts still assume - * certain character properties of these constants, namely that - * isUPPER() and toLOWER() may do useful mappings. - * - * Update the magic_names table in dump.c when adding/amending these - */ - -#define PERL_MAGIC_sv '\0' /* Special scalar variable */ -#define PERL_MAGIC_overload 'A' /* %OVERLOAD hash */ -#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 'D' /* Regex match position data - (@+ and @- vars) */ -#define PERL_MAGIC_regdatum 'd' /* Regex match position data element */ -#define PERL_MAGIC_env 'E' /* %ENV hash */ -#define PERL_MAGIC_envelem 'e' /* %ENV hash element */ -#define PERL_MAGIC_fm 'f' /* Formline ('compiled' format) */ -#define PERL_MAGIC_regex_global 'g' /* m//g target / study()ed string */ -#define PERL_MAGIC_hints 'H' /* %^H hash */ -#define PERL_MAGIC_hintselem 'h' /* %^H hash element */ -#define PERL_MAGIC_isa 'I' /* @ISA array */ -#define PERL_MAGIC_isaelem 'i' /* @ISA array element */ -#define PERL_MAGIC_nkeys 'k' /* scalar(keys()) lvalue */ -#define PERL_MAGIC_dbfile 'L' /* Debugger %_ #endif @@ -4249,11 +4200,25 @@ extern char ** environ; /* environment variables supplied via exec */ # endif #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) + +#define PERL_API_VERSION_STRING STRINGIFY(PERL_API_REVISION) "." \ + STRINGIFY(PERL_API_VERSION) "." \ + STRINGIFY(PERL_API_SUBVERSION) + START_EXTERN_C /* handy constants */ EXTCONST char PL_warn_uninit[] INIT("Use of uninitialized value%s%s%s"); +EXTCONST char PL_warn_uninit_sv[] + INIT("Use of uninitialized value%"SVf"%s%s"); EXTCONST char PL_warn_nosemi[] INIT("Semicolon seems to be missing"); EXTCONST char PL_warn_reserved[] @@ -4293,21 +4258,53 @@ EXTCONST char PL_no_localize_ref[] EXTCONST char PL_memory_wrap[] INIT("panic: memory wrap"); +EXTCONST char PL_Yes[] + INIT("1"); +EXTCONST char PL_No[] + INIT(""); +EXTCONST char PL_hexdigit[] + INIT("0123456789abcdef0123456789ABCDEF"); + +/* This is constant on most architectures, a global on OS/2 */ +#ifndef OS2 +EXTCONST char PL_sh_path[] + INIT(SH_PATH); /* full path of shell */ +#endif + #ifdef CSH EXTCONST char PL_cshname[] INIT(CSH); # define PL_cshlen (sizeof(CSH "") - 1) #endif +/* These are baked at compile time into any shared perl library. + In future releases this will allow us in main() to sanity test the + library we're linking against. */ + +EXTCONST U8 PL_revision + INIT(PERL_REVISION); +EXTCONST U8 PL_version + INIT(PERL_VERSION); +EXTCONST U8 PL_subversion + INIT(PERL_SUBVERSION); + EXTCONST char PL_uuemap[65] INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); #ifdef DOINIT EXTCONST char PL_uudmap[256] = -#include "uudmap.h" +# ifdef PERL_MICRO +# include "uuudmap.h" +# else +# include "uudmap.h" +# endif ; EXTCONST char PL_bitcount[256] = -# include "bitcount.h" +# ifdef PERL_MICRO +# include "ubitcount.h" +#else +# include "bitcount.h" +# endif ; EXTCONST char* const PL_sig_name[] = { SIG_NAME }; EXTCONST int PL_sig_num[] = { SIG_NUM }; @@ -4604,7 +4601,9 @@ EXTCONST unsigned char PL_freq[] = { /* letter frequencies for mixed English/C * EXTCONST unsigned char PL_freq[]; #endif -#ifdef DEBUGGING +/* Although only used for debugging, these constants must be available in + * non-debugging builds too, since they're used in ext/re/re_exec.c, + * which has DEBUGGING enabled always */ #ifdef DOINIT EXTCONST char* const PL_block_type[] = { "NULL", @@ -4623,7 +4622,6 @@ EXTCONST char* const PL_block_type[] = { #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 @@ -4641,12 +4639,24 @@ EXTCONST char PL_bincompat_options[] = # ifdef FAKE_THREADS " FAKE_THREADS" # endif +# ifdef FCRYPT + " FCRYPT" +# endif +# ifdef HAS_TIMES + " HAS_TIMES" +# endif +# ifdef HAVE_INTERP_INTERN + " HAVE_INTERP_INTERN" +# endif # ifdef MULTIPLICITY " MULTIPLICITY" # endif # ifdef MYMALLOC " MYMALLOC" # endif +# ifdef PERLIO_LAYERS + " PERLIO_LAYERS" +# endif # ifdef PERL_DEBUG_READONLY_OPS " PERL_DEBUG_READONLY_OPS" # endif @@ -4662,6 +4672,9 @@ EXTCONST char PL_bincompat_options[] = # ifdef PERL_MAD " PERL_MAD" # endif +# ifdef PERL_MICRO + " PERL_MICRO" +# endif # ifdef PERL_NEED_APPCTX " PERL_NEED_APPCTX" # endif @@ -4680,12 +4693,6 @@ EXTCONST char PL_bincompat_options[] = # 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 @@ -4701,6 +4708,12 @@ EXTCONST char PL_bincompat_options[] = # ifdef USE_LARGE_FILES " USE_LARGE_FILES" # endif +# ifdef USE_LOCALE_COLLATE + " USE_LOCALE_COLLATE" +# endif +# ifdef USE_LOCALE_NUMERIC + " USE_LOCALE_NUMERIC" +# endif # ifdef USE_LONG_DOUBLE " USE_LONG_DOUBLE" # endif @@ -4718,21 +4731,24 @@ EXTCONST char PL_bincompat_options[] = # 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 # ifdef VMS_SHORTEN_LONG_SYMBOLS " VMS_SHORTEN_LONG_SYMBOLS" # endif +# ifdef VMS_WE_ARE_CASE_SENSITIVE + " VMS_SYMBOL_CASE_AS_IS" +# endif ""; #else EXTCONST char PL_bincompat_options[]; #endif +#ifndef PERL_SET_PHASE +# define PERL_SET_PHASE(new_phase) \ + PHASE_CHANGE_PROBE(PL_phase_names[new_phase], PL_phase_names[PL_phase]); \ + PL_phase = new_phase; +#endif + /* The interpreter phases. If these ever change, PL_phase_names right below will * need to be updated accordingly. */ enum perl_phase { @@ -4764,6 +4780,8 @@ EXTCONST char *const PL_phase_names[]; * instead of using the newer PL_phase, which provides everything PL_dirty * provided, and more. */ # define PL_dirty (PL_phase == PERL_PHASE_DESTRUCT) + +# define PL_amagic_generation PL_na #endif /* !PERL_CORE */ END_EXTERN_C @@ -4798,44 +4816,6 @@ typedef enum { /* update exp_name[] in toke.c if adding to this enum */ } expectation; -enum { /* pass one of these to get_vtbl */ - want_vtbl_sv, - want_vtbl_env, - want_vtbl_envelem, - want_vtbl_sig, - want_vtbl_sigelem, - want_vtbl_pack, - want_vtbl_packelem, - want_vtbl_dbline, - want_vtbl_isa, - want_vtbl_isaelem, - want_vtbl_arylen, - want_vtbl_glob, - want_vtbl_mglob, - want_vtbl_nkeys, - want_vtbl_taint, - want_vtbl_substr, - want_vtbl_vec, - want_vtbl_pos, - want_vtbl_bm, - want_vtbl_fm, - want_vtbl_uvar, - want_vtbl_defelem, - want_vtbl_regexp, - want_vtbl_collxfrm, - want_vtbl_amagic, - want_vtbl_amagicelem, - want_vtbl_regdata, - want_vtbl_regdatum, - want_vtbl_backref, - want_vtbl_utf8, - want_vtbl_symtab, - want_vtbl_arylen_p, - want_vtbl_hintselem, - want_vtbl_hints -}; - - /* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer special and there is no need for HINT_PRIVATE_MASK for COPs However, bitops store HINT_INTEGER in their op_private. */ @@ -4843,9 +4823,11 @@ enum { /* pass one of these to get_vtbl */ #define HINT_STRICT_REFS 0x00000002 /* strict pragma */ #define HINT_LOCALE 0x00000004 /* locale pragma */ #define HINT_BYTES 0x00000008 /* bytes pragma */ -#define HINT_ARYBASE 0x00000010 /* $[ is non-zero */ - /* Note: 20,40,80 used for NATIVE_HINTS */ - /* currently defined by vms/vmsish.h */ +#define HINT_LOCALE_NOT_CHARS 0x00000010 /* locale ':not_characters' pragma */ + +#define HINT_EXPLICIT_STRICT_REFS 0x00000020 /* strict.pm */ +#define HINT_EXPLICIT_STRICT_SUBS 0x00000040 /* strict.pm */ +#define HINT_EXPLICIT_STRICT_VARS 0x00000080 /* strict.pm */ #define HINT_BLOCK_SCOPE 0x00000100 #define HINT_STRICT_SUBS 0x00000200 /* strict pragma */ @@ -4872,6 +4854,14 @@ enum { /* pass one of these to get_vtbl */ #define HINT_RE_FLAGS 0x02000000 /* re '/xism' pragma */ +#define HINT_FEATURE_MASK 0x1c000000 /* 3 bits for feature bundles */ + + /* Note: Used for NATIVE_HINTS, currently + defined by vms/vmsish.h: + 0x40000000 + 0x80000000 + */ + /* The following are stored in $^H{sort}, not in PL_hints */ #define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */ #define HINT_SORT_QUICKSORT 0x00000001 @@ -4920,19 +4910,14 @@ typedef void (*XSINIT_t) (pTHX); typedef void (*ATEXIT_t) (pTHX_ void*); typedef void (*XSUBADDR_t) (pTHX_ CV *); -/* Set up PERLVAR macros for populating structs */ -#define PERLVAR(var,type) type var; -#define PERLVARA(var,n,type) type var[n]; -#define PERLVARI(var,type,init) type var; -#define PERLVARIC(var,type,init) type var; -#define PERLVARISC(var,init) const char var[sizeof(init)]; - typedef OP* (*Perl_ppaddr_t)(pTHX); typedef OP* (*Perl_check_t) (pTHX_ OP*); typedef void(*Perl_ophook_t)(pTHX_ OP*); typedef int (*Perl_keyword_plugin_t)(pTHX_ char*, STRLEN, OP**); typedef void(*Perl_cpeep_t)(pTHX_ OP *, OP *); +typedef void(*globhook_t)(pTHX); + #define KEYWORD_PLUGIN_DECLINE 0 #define KEYWORD_PLUGIN_STMT 1 #define KEYWORD_PLUGIN_EXPR 2 @@ -4953,63 +4938,79 @@ 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) - -#define PERL_API_VERSION_STRING STRINGIFY(PERL_API_REVISION) "." \ - STRINGIFY(PERL_API_VERSION) "." \ - STRINGIFY(PERL_API_SUBVERSION) +#if !defined(MULTIPLICITY) -#ifdef PERL_GLOBAL_STRUCT -struct perl_vars { -# include "perlvars.h" +struct interpreter { + char broiled; }; -# ifdef PERL_CORE -# ifndef PERL_GLOBAL_STRUCT_PRIVATE -EXT struct perl_vars PL_Vars; -EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); -# undef PERL_GET_VARS -# define PERL_GET_VARS() PL_VarsPtr -# endif /* !PERL_GLOBAL_STRUCT_PRIVATE */ -# else /* PERL_CORE */ -# if !defined(__GNUC__) || !defined(WIN32) -EXT -# endif /* WIN32 */ -struct perl_vars *PL_VarsPtr; -# define PL_Vars (*((PL_VarsPtr) \ - ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX)))) -# endif /* PERL_CORE */ -#endif /* PERL_GLOBAL_STRUCT */ +#else -#if defined(MULTIPLICITY) /* If we have multiple interpreters define a struct holding variables which must be per-interpreter If we don't have threads anything that would have be per-thread is per-interpreter. */ +/* Set up PERLVAR macros for populating structs */ +# define PERLVAR(prefix,var,type) type prefix##var; +# define PERLVARA(prefix,var,n,type) type prefix##var[n]; +# define PERLVARI(prefix,var,type,init) type prefix##var; +# define PERLVARIC(prefix,var,type,init) type prefix##var; + struct interpreter { # include "intrpvar.h" }; -#else -struct interpreter { - char broiled; +EXTCONST U16 PL_interp_size + INIT(sizeof(struct interpreter)); + +# define PERL_INTERPRETER_SIZE_UPTO_MEMBER(member) \ + STRUCT_OFFSET(struct interpreter, member) + \ + sizeof(((struct interpreter*)0)->member) + +/* This will be useful for subsequent releases, because this has to be the + same in your libperl as in main(), else you have a mismatch and must abort. +*/ +EXTCONST U16 PL_interp_size_5_16_0 + INIT(PERL_INTERPRETER_SIZE_UPTO_MEMBER(PERL_LAST_5_16_0_INTERP_MEMBER)); + + +# ifdef PERL_GLOBAL_STRUCT +/* MULTIPLICITY is automatically defined when PERL_GLOBAL_STRUCT is defined, + hence it's safe and sane to nest this within #ifdef MULTIPLICITY */ + +struct perl_vars { +# include "perlvars.h" }; -#endif /* MULTIPLICITY */ + +EXTCONST U16 PL_global_struct_size + INIT(sizeof(struct perl_vars)); + +# ifdef PERL_CORE +# ifndef PERL_GLOBAL_STRUCT_PRIVATE +EXT struct perl_vars PL_Vars; +EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); +# undef PERL_GET_VARS +# define PERL_GET_VARS() PL_VarsPtr +# endif /* !PERL_GLOBAL_STRUCT_PRIVATE */ +# else /* PERL_CORE */ +# if !defined(__GNUC__) || !defined(WIN32) +EXT +# endif /* WIN32 */ +struct perl_vars *PL_VarsPtr; +# define PL_Vars (*((PL_VarsPtr) \ + ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX)))) +# endif /* PERL_CORE */ +# endif /* PERL_GLOBAL_STRUCT */ /* Done with PERLVAR macros for now ... */ -#undef PERLVAR -#undef PERLVARA -#undef PERLVARI -#undef PERLVARIC -#undef PERLVARISC +# undef PERLVAR +# undef PERLVARA +# undef PERLVARI +# undef PERLVARIC + +#endif /* MULTIPLICITY */ struct tempsym; /* defined in pp_pack.c */ @@ -5023,6 +5024,10 @@ struct tempsym; /* defined in pp_pack.c */ # define PERL_CALLCONV # endif #endif +#ifndef PERL_CALLCONV_NO_RET +# define PERL_CALLCONV_NO_RET PERL_CALLCONV +#endif + #undef PERL_CKDEF #undef PERL_PPDEF #define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o); @@ -5054,11 +5059,10 @@ struct tempsym; /* defined in pp_pack.c */ * these include variables that would have been their struct-s */ -#define PERLVAR(var,type) EXT type PL_##var; -#define PERLVARA(var,n,type) EXT type PL_##var[n]; -#define PERLVARI(var,type,init) EXT type PL_##var INIT(init); -#define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init); -#define PERLVARISC(var,init) EXTCONST char PL_##var[sizeof(init)] INIT(init); +#define PERLVAR(prefix,var,type) EXT type PL_##var; +#define PERLVARA(prefix,var,n,type) EXT type PL_##var[n]; +#define PERLVARI(prefix,var,type,init) EXT type PL_##var INIT(init); +#define PERLVARIC(prefix,var,type,init) EXTCONST type PL_##var INIT(init); #if !defined(MULTIPLICITY) START_EXTERN_C @@ -5071,13 +5075,13 @@ END_EXTERN_C # undef PL_na #endif -#if defined(WIN32) -/* Now all the config stuff is setup we can include embed.h */ -# include "embed.h" -# ifndef PERL_MAD -# undef op_getmad -# define op_getmad(arg,pegop,slot) NOOP -# endif +/* Now all the config stuff is setup we can include embed.h + In particular, need the relevant *ish file included already, as it may + define HAVE_INTERP_INTERN */ +#include "embed.h" +#ifndef PERL_MAD +# undef op_getmad +# define op_getmad(arg,pegop,slot) NOOP #endif #ifndef PERL_GLOBAL_STRUCT @@ -5095,6 +5099,14 @@ END_EXTERN_C START_EXTERN_C +/* dummy variables that hold pointers to both runops functions, thus forcing + * them *both* to get linked in (useful for Peek.xs, debugging etc) */ + +EXTCONST runops_proc_t PL_runops_std + INIT(Perl_runops_standard); +EXTCONST runops_proc_t PL_runops_dbg + INIT(Perl_runops_debug); + /* PERL_GLOBAL_STRUCT_PRIVATE wants to keep global data like the * magic vtables const, but this is incompatible with SWIG which * does want to modify the vtables. */ @@ -5104,461 +5116,71 @@ START_EXTERN_C # define EXT_MGVTBL EXT MGVTBL #endif +#define PERL_MAGIC_READONLY_ACCEPTABLE 0x40 +#define PERL_MAGIC_VALUE_MAGIC 0x80 +#define PERL_MAGIC_VTABLE_MASK 0x3F +#define PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(t) \ + (PL_magic_data[(U8)(t)] & PERL_MAGIC_READONLY_ACCEPTABLE) +#define PERL_MAGIC_TYPE_IS_VALUE_MAGIC(t) \ + (PL_magic_data[(U8)(t)] & PERL_MAGIC_VALUE_MAGIC) + +#include "mg_vtable.h" + #ifdef DOINIT -# define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var = {a,b,c,d,e,f,g,h} -/* Like MGVTBL_SET but with the get magic having a const MG* */ -# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var \ - = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g,h} +EXTCONST U8 PL_magic_data[256] = +# ifdef PERL_MICRO +# include "umg_data.h" +# else +# include "mg_data.h" +# endif +; #else -# define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var -# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var +EXTCONST U8 PL_magic_data[256]; #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) - */ +#ifdef DOINIT + /* NL BD IV NV PV PI PN MG RX GV LV AV HV CV FM IO */ +EXTCONST bool +PL_valid_types_IVX[] = { 0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 }; +EXTCONST bool +PL_valid_types_NVX[] = { 0, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 }; +EXTCONST bool +PL_valid_types_PVX[] = { 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1 }; +EXTCONST bool +PL_valid_types_RV[] = { 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1 }; +EXTCONST bool +PL_valid_types_IV_set[] = { 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1 }; +EXTCONST bool +PL_valid_types_NV_set[] = { 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 }; -/* args are: - vtable - get - set - len - clear - free - copy - dup - local -*/ +#else -MGVTBL_SET( - PL_vtbl_sv, - Perl_magic_get, - Perl_magic_set, - Perl_magic_len, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_env, - 0, - Perl_magic_set_all_env, - 0, - Perl_magic_clear_all_env, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_envelem, - 0, - Perl_magic_setenv, - 0, - Perl_magic_clearenv, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_sig, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0 -); +EXTCONST bool PL_valid_types_IVX[]; +EXTCONST bool PL_valid_types_NVX[]; +EXTCONST bool PL_valid_types_PVX[]; +EXTCONST bool PL_valid_types_RV[]; +EXTCONST bool PL_valid_types_IV_set[]; +EXTCONST bool PL_valid_types_NV_set[]; -#ifdef PERL_MICRO -MGVTBL_SET( - PL_vtbl_sigelem, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0 -); +#endif -#else -MGVTBL_SET( - PL_vtbl_sigelem, - Perl_magic_getsig, - Perl_magic_setsig, - 0, - Perl_magic_clearsig, - 0, - 0, - 0, - 0 -); -#endif - -MGVTBL_SET( - PL_vtbl_pack, - 0, - 0, - Perl_magic_sizepack, - Perl_magic_wipepack, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_packelem, - Perl_magic_getpack, - Perl_magic_setpack, - 0, - Perl_magic_clearpack, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_dbline, - 0, - Perl_magic_setdbline, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_isa, - 0, - Perl_magic_setisa, - 0, - Perl_magic_clearisa, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_isaelem, - 0, - Perl_magic_setisa, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET_CONST_MAGIC_GET( - PL_vtbl_arylen, - Perl_magic_getarylen, - Perl_magic_setarylen, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_arylen_p, - 0, - 0, - 0, - 0, - Perl_magic_freearylen_p, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_mglob, - 0, - Perl_magic_setmglob, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_nkeys, - Perl_magic_getnkeys, - Perl_magic_setnkeys, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_taint, - Perl_magic_gettaint, - Perl_magic_settaint, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_substr, - Perl_magic_getsubstr, - Perl_magic_setsubstr, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_vec, - Perl_magic_getvec, - Perl_magic_setvec, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_pos, - Perl_magic_getpos, - Perl_magic_setpos, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_bm, - 0, - Perl_magic_setregexp, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_fm, - 0, - Perl_magic_setregexp, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_uvar, - Perl_magic_getuvar, - Perl_magic_setuvar, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_defelem, - Perl_magic_getdefelem, - Perl_magic_setdefelem, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_regexp, - 0, - Perl_magic_setregexp, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_regdata, - 0, - 0, - Perl_magic_regdata_cnt, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_regdatum, - Perl_magic_regdatum_get, - Perl_magic_regdatum_set, - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_amagic, - 0, - Perl_magic_setamagic, - 0, - 0, - Perl_magic_setamagic, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_amagicelem, - 0, - Perl_magic_setamagic, - 0, - 0, - Perl_magic_setamagic, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_backref, - 0, - 0, - 0, - 0, - Perl_magic_killbackrefs, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_ovrld, - 0, - 0, - 0, - 0, - Perl_magic_freeovrld, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_utf8, - 0, - Perl_magic_setutf8, - 0, - 0, - 0, - 0, - 0, - 0 -); -#ifdef USE_LOCALE_COLLATE -MGVTBL_SET( - PL_vtbl_collxfrm, - 0, - Perl_magic_setcollxfrm, - 0, - 0, - 0, - 0, - 0, - 0 -); -#endif - -MGVTBL_SET( - PL_vtbl_hintselem, - 0, - Perl_magic_sethint, - 0, - Perl_magic_clearhint, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_hints, - 0, - 0, - 0, - Perl_magic_clearhints, - 0, - 0, - 0, - 0 -); #include "overload.h" END_EXTERN_C struct am_table { - U32 flags; + U8 flags; + U8 fallback; + U16 spare; U32 was_ok_sub; - long was_ok_am; - long fallback; CV* table[NofAMmeth]; }; struct am_table_short { - U32 flags; + U8 flags; + U8 fallback; + U16 spare; U32 was_ok_sub; - long was_ok_am; }; typedef struct am_table AMT; typedef struct am_table_short AMTS; @@ -5652,11 +5274,23 @@ typedef struct am_table_short AMTS; #define SET_NUMERIC_LOCAL() \ set_numeric_local(); +/* Returns non-zero If the plain locale pragma without a parameter is in effect + */ #define IN_LOCALE_RUNTIME (CopHINTS_get(PL_curcop) & HINT_LOCALE) + +/* Returns non-zero If either form of the locale pragma is in effect */ +#define IN_SOME_LOCALE_FORM_RUNTIME \ + (CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS)) + #define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) +#define IN_SOME_LOCALE_FORM_COMPILETIME \ + (PL_hints & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS)) #define IN_LOCALE \ (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) +#define IN_SOME_LOCALE_FORM \ + (IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \ + : IN_SOME_LOCALE_FORM_RUNTIME) #define STORE_NUMERIC_LOCAL_SET_STANDARD() \ bool was_local = PL_numeric_local && IN_LOCALE; \ @@ -5876,10 +5510,12 @@ typedef struct am_table_short AMTS; * the interpreter goes away.) */ # define MY_CXT_INIT \ my_cxt_t *my_cxtp = \ - (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_INIT_ARG, sizeof(my_cxt_t)) + (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \ + PERL_UNUSED_VAR(my_cxtp) # define MY_CXT_INIT_INTERP(my_perl) \ my_cxt_t *my_cxtp = \ - (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_INIT_ARG, sizeof(my_cxt_t)) + (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \ + PERL_UNUSED_VAR(my_cxtp) /* This declaration should be used within all functions that use the * interpreter-local data. */ @@ -5896,7 +5532,7 @@ typedef struct am_table_short AMTS; /* This macro must be used to access members of the my_cxt_t structure. - * e.g. MYCXT.some_data */ + * e.g. MY_CXT.some_data */ # define MY_CXT (*my_cxtp) /* Judicious use of these macros can reduce the number of times dMY_CXT @@ -6000,6 +5636,8 @@ int flock(int fd, int op); #define PERL_SCAN_ALLOW_UNDERSCORES 0x01 /* grok_??? accept _ in numbers */ #define PERL_SCAN_DISALLOW_PREFIX 0x02 /* grok_??? reject 0x in hex etc */ #define PERL_SCAN_SILENT_ILLDIGIT 0x04 /* grok_??? not warn about illegal digits */ +#define PERL_SCAN_SILENT_NON_PORTABLE 0x08 /* grok_??? not warn about very large + numbers which are <= UV_MAX */ /* Output flags: */ #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */ @@ -6089,36 +5727,6 @@ extern void moncontrol(int); #define PERL_SIGNALS_UNSAFE_FLAG 0x0001 -/* From sigaction(2) (FreeBSD man page): - * | Signal routines normally execute with the signal that - * | caused their invocation blocked, but other signals may - * | yet occur. - * Emulation of this behavior (from within Perl) is enabled - * by defining PERL_BLOCK_SIGNALS. - */ -#define PERL_BLOCK_SIGNALS - -#if defined(HAS_SIGPROCMASK) && defined(PERL_BLOCK_SIGNALS) -# define PERL_BLOCKSIG_ADD(set,sig) \ - sigset_t set; sigemptyset(&(set)); sigaddset(&(set), sig) -# define PERL_BLOCKSIG_BLOCK(set) \ - sigprocmask(SIG_BLOCK, &(set), NULL) -# define PERL_BLOCKSIG_UNBLOCK(set) \ - sigprocmask(SIG_UNBLOCK, &(set), NULL) -#endif /* HAS_SIGPROCMASK && PERL_BLOCK_SIGNALS */ - -/* How about the old style of sigblock()? */ - -#ifndef PERL_BLOCKSIG_ADD -# define PERL_BLOCKSIG_ADD(set, sig) NOOP -#endif -#ifndef PERL_BLOCKSIG_BLOCK -# define PERL_BLOCKSIG_BLOCK(set) NOOP -#endif -#ifndef PERL_BLOCKSIG_UNBLOCK -# define PERL_BLOCKSIG_UNBLOCK(set) NOOP -#endif - /* Use instead of abs() since abs() forces its argument to be an int, * but also beware since this evaluates its argument twice, so no x++. */ #define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) @@ -6228,8 +5836,8 @@ extern void moncontrol(int); * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 - * indent-tabs-mode: t + * indent-tabs-mode: nil * End: * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */