X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/16c915390a3e066a7c2c13fac10d8dd8ebfea0c6..f5a6ef4f29896910e05e3348d6839fb3e0904b15:/perl.h diff --git a/perl.h b/perl.h index d9b2228..4d20047 100644 --- a/perl.h +++ b/perl.h @@ -225,6 +225,7 @@ #define _PERL_OBJECT_THIS #define PERL_OBJECT_THIS_ #define CALL_FPTR(fptr) (*fptr) +#define MEMBER_TO_FPTR(name) name #endif /* !PERL_CORE */ #define CALLRUNOPS PL_runops @@ -353,11 +354,12 @@ #endif #define NOOP /*EMPTY*/(void)0 -#if !defined(HASATTRIBUTE_UNUSED) && defined(__cplusplus) -#define dNOOP /*EMPTY*/(void)0 /* Older g++ has no __attribute((unused))__ */ -#else -#define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL -#endif +/* 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. */ +#define dNOOP extern int Perl___notused() #ifndef pTHX /* Don't bother defining tTHX and sTHX; using them outside @@ -540,6 +542,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. */ @@ -590,7 +601,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # endif #endif -/* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that +/* HP-UX 10.X CMA (Common Multithreaded Architecture) insists that pthread.h must be included before all other header files. */ #if defined(USE_ITHREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) @@ -2225,7 +2236,7 @@ int isnan(double d); # include #endif /* Included values.h above if necessary; still including limits.h down here, - * despite doing above, because math.h might have overriden... XXX - Allen */ + * despite doing above, because math.h might have overridden... XXX - Allen */ /* * Try to figure out max and min values for the integral types. THE CORRECT @@ -2386,10 +2397,6 @@ int isnan(double d); #endif -#ifdef MYMALLOC -# include "malloc_ctl.h" -#endif - struct RExC_state_t; struct _reg_trie_data; @@ -2413,6 +2420,7 @@ typedef struct pvop PVOP; typedef struct loop LOOP; typedef struct block_hooks BHK; +typedef struct custom_op XOP; typedef struct interpreter PerlInterpreter; @@ -2427,7 +2435,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; @@ -3123,10 +3130,6 @@ typedef pthread_key_t perl_key; #define PERL_EXIT_EXPECTED 0x01 #define PERL_EXIT_DESTRUCT_END 0x02 /* Run END in perl_destruct */ -#ifndef MEMBER_TO_FPTR -# define MEMBER_TO_FPTR(name) name -#endif - #ifndef PERL_CORE /* format to use for version numbers in file/directory names */ /* XXX move to Configure? */ @@ -3183,7 +3186,7 @@ typedef pthread_key_t perl_key; All that is required is that the perl source does not use "%-p" or "%-p" or "%p" formats. These formats will still work in perl code. - See comments in sv.c for futher details. + See comments in sv.c for further details. Robin Barker 2005-07-14 @@ -3209,7 +3212,7 @@ typedef pthread_key_t perl_key; #define SVfARG(p) ((void*)(p)) #ifdef PERL_CORE -/* not used; but needed for backward compatibilty with XS code? - RMB */ +/* not used; but needed for backward compatibility with XS code? - RMB */ # undef VDf #else # ifndef VDf @@ -3218,7 +3221,7 @@ typedef pthread_key_t perl_key; #endif #ifdef PERL_CORE -/* not used; but needed for backward compatibilty with XS code? - RMB */ +/* not used; but needed for backward compatibility with XS code? - RMB */ # undef UVf #else # ifndef UVf @@ -3705,6 +3708,7 @@ Gid_t getegid (void); # define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG) # define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_) # define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_) +# define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_) #ifdef DEBUGGING @@ -3735,6 +3739,7 @@ Gid_t getegid (void); # define DEBUG_B_TEST DEBUG_B_TEST_ # define DEBUG_Xv_TEST DEBUG_Xv_TEST_ # define DEBUG_Uv_TEST DEBUG_Uv_TEST_ +# define DEBUG_Pv_TEST DEBUG_Pv_TEST_ # define PERL_DEB(a) a # define PERL_DEBUG(a) if (PL_debug) a @@ -3772,6 +3777,7 @@ Gid_t getegid (void); # define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a) # define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a) # define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a) +# define DEBUG_Pv(a) DEBUG__(DEBUG_Pv_TEST, a) # define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a) # define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a) @@ -3811,6 +3817,7 @@ Gid_t getegid (void); # define DEBUG_B_TEST (0) # define DEBUG_Xv_TEST (0) # define DEBUG_Uv_TEST (0) +# define DEBUG_Pv_TEST (0) # define PERL_DEB(a) # define PERL_DEBUG(a) @@ -3840,6 +3847,7 @@ Gid_t getegid (void); # define DEBUG_B(a) # define DEBUG_Xv(a) # define DEBUG_Uv(a) +# define DEBUG_Pv(a) #endif /* DEBUGGING */ @@ -3849,62 +3857,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 @@ -4224,9 +4176,6 @@ typedef OP* (*PPADDR_t[]) (pTHX); typedef bool (*destroyable_proc_t) (pTHX_ SV *sv); typedef void (*despatch_signals_proc_t) (pTHX); -/* _ (for $_) must be first in the following list (DEFSV requires it) */ -#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" - /* NeXT has problems with crt0.o globals */ #if defined(__DYNAMIC__) && \ (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN)) @@ -4252,6 +4201,18 @@ 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 */ @@ -4296,12 +4257,36 @@ 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[\\]^_"); @@ -4321,45 +4306,16 @@ EXTCONST char* const PL_sig_name[]; EXTCONST int PL_sig_num[]; #endif -/* fast conversion and case folding tables */ +/* fast conversion and case folding tables. The folding tables complement the + * fold, so that 'a' maps to 'A' and 'A' maps to 'a', ignoring more complicated + * folds such as outside the range or to multiple characters. */ #ifdef DOINIT -#ifdef EBCDIC -EXTCONST unsigned char PL_fold[] = { /* fast EBCDIC case folding table */ - 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 10, 11, 12, 13, 14, 15, - 16, 17, 18, 19, 20, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, - 48, 49, 50, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 60, 61, 62, 63, - 64, 65, 66, 67, 68, 69, 70, 71, - 72, 73, 74, 75, 76, 77, 78, 79, - 80, 81, 82, 83, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 95, - 96, 97, 98, 99, 100, 101, 102, 103, - 104, 105, 106, 107, 108, 109, 110, 111, - 112, 113, 114, 115, 116, 117, 118, 119, - 120, 121, 122, 123, 124, 125, 126, 127, - 128, 'A', 'B', 'C', 'D', 'E', 'F', 'G', - 'H', 'I', 138, 139, 140, 141, 142, 143, - 144, 'J', 'K', 'L', 'M', 'N', 'O', 'P', - 'Q', 'R', 154, 155, 156, 157, 158, 159, - 160, 161, 'S', 'T', 'U', 'V', 'W', 'X', - 'Y', 'Z', 170, 171, 172, 173, 174, 175, - 176, 177, 178, 179, 180, 181, 182, 183, - 184, 185, 186, 187, 188, 189, 190, 191, - 192, 'a', 'b', 'c', 'd', 'e', 'f', 'g', - 'h', 'i', 202, 203, 204, 205, 206, 207, - 208, 'j', 'k', 'l', 'm', 'n', 'o', 'p', - 'q', 'r', 218, 219, 220, 221, 222, 223, - 224, 225, 's', 't', 'u', 'v', 'w', 'x', - 'y', 'z', 234, 235, 236, 237, 238, 239, - 240, 241, 242, 243, 244, 245, 246, 247, - 248, 249, 250, 251, 252, 253, 254, 255 -}; -#else /* ascii rather than ebcdic */ +#ifndef EBCDIC + +/* The EBCDIC fold table depends on the code page, and hence is found in + * utfebcdic.h */ + EXTCONST unsigned char PL_fold[] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, @@ -4394,6 +4350,49 @@ EXTCONST unsigned char PL_fold[] = { 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255 }; +EXTCONST unsigned char PL_fold_latin1[] = { + /* Full latin1 complement folding, except for three problematic code points: + * Micro sign (181 = 0xB5) and y with diearesis (255 = 0xFF) have their + * fold complements outside the Latin1 range, so can't match something + * that isn't in utf8. + * German lower case sharp s (223 = 0xDF) folds to two characters, 'ss', + * not one, so can't be represented in this table. + * + * All have to be specially handled */ + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', + 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', + 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', + 'x', 'y', 'z', 91, 92, 93, 94, 95, + 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', + 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', + 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', + 'X', 'Y', 'Z', 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, + 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, + 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181 /*micro */, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32, + 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32, + 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215, + 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223 /* ss */, + 224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32, + 232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32, + 240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247, + 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, + 255 /* y with diaeresis */ +}; #endif /* !EBCDIC, but still in DOINIT */ /* If these tables are accessed through ebcdic, the access will be converted to @@ -4471,6 +4470,7 @@ EXTCONST unsigned char PL_mod_latin1_uc[] = { }; #else /* ! DOINIT */ EXTCONST unsigned char PL_fold[]; +EXTCONST unsigned char PL_fold_latin1[]; EXTCONST unsigned char PL_mod_latin1_uc[]; EXTCONST unsigned char PL_latin1_lc[]; #endif @@ -4706,18 +4706,57 @@ 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 ""; #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 { + PERL_PHASE_CONSTRUCT = 0, + PERL_PHASE_START = 1, + PERL_PHASE_CHECK = 2, + PERL_PHASE_INIT = 3, + PERL_PHASE_RUN = 4, + PERL_PHASE_END = 5, + PERL_PHASE_DESTRUCT = 6 +}; + +#ifdef DOINIT +EXTCONST char *const PL_phase_names[] = { + "CONSTRUCT", + "START", + "CHECK", + "INIT", + "RUN", + "END", + "DESTRUCT" +}; +#else +EXTCONST char *const PL_phase_names[]; +#endif + +#ifndef PERL_CORE +/* Do not use this macro. It only exists for extensions that rely on PL_dirty + * instead of using the newer PL_phase, which provides everything PL_dirty + * provided, and more. */ +# define PL_dirty (PL_phase == PERL_PHASE_DESTRUCT) +#endif /* !PERL_CORE */ + END_EXTERN_C /*****************************************************************************/ @@ -4750,44 +4789,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. */ @@ -4822,6 +4823,8 @@ enum { /* pass one of these to get_vtbl */ #define HINT_NO_AMAGIC 0x01000000 /* overloading pragma */ +#define HINT_RE_FLAGS 0x02000000 /* re '/xism' pragma */ + /* 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 @@ -4860,6 +4863,7 @@ typedef char* (*re_intuit_start_t) (pTHX_ regexp *prog, SV *sv, typedef SV* (*re_intuit_string_t) (pTHX_ regexp *prog); typedef void (*regfree_t) (pTHX_ struct regexp* r); typedef regexp* (*regdupe_t) (pTHX_ const regexp* r, CLONE_PARAMS *param); +typedef I32 (*re_fold_t)(const char *, char const *, I32); typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*); typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*); @@ -4869,17 +4873,11 @@ 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 *); #define KEYWORD_PLUGIN_DECLINE 0 #define KEYWORD_PLUGIN_STMT 1 @@ -4901,63 +4899,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(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; + 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 */ @@ -4976,6 +4990,10 @@ struct tempsym; /* defined in pp_pack.c */ #define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o); #define PERL_PPDEF(s) PERL_CALLCONV OP *s (pTHX); +#ifdef MYMALLOC +# include "malloc_ctl.h" +#endif + #include "proto.h" /* this has structure inits, so it cannot be included before here */ @@ -5002,7 +5020,6 @@ struct tempsym; /* defined in pp_pack.c */ #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); #if !defined(MULTIPLICITY) START_EXTERN_C @@ -5039,6 +5056,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. */ @@ -5048,459 +5073,40 @@ START_EXTERN_C # define EXT_MGVTBL EXT MGVTBL #endif -#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} -#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 -#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) - */ - -/* args are: - vtable - get - set - len - clear - free - copy - dup - local -*/ - -MGVTBL_SET( - PL_vtbl_sv, - MEMBER_TO_FPTR(Perl_magic_get), - MEMBER_TO_FPTR(Perl_magic_set), - MEMBER_TO_FPTR(Perl_magic_len), - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_env, - 0, - MEMBER_TO_FPTR(Perl_magic_set_all_env), - 0, - MEMBER_TO_FPTR(Perl_magic_clear_all_env), - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_envelem, - 0, - MEMBER_TO_FPTR(Perl_magic_setenv), - 0, - MEMBER_TO_FPTR(Perl_magic_clearenv), - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_sig, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0 -); +#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) -#ifdef PERL_MICRO -MGVTBL_SET( - PL_vtbl_sigelem, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0 -); +#include "mg_vtable.h" +#ifdef DOINIT +EXTCONST U8 PL_magic_data[256] = +#include "mg_data.h" +; #else -MGVTBL_SET( - PL_vtbl_sigelem, - MEMBER_TO_FPTR(Perl_magic_getsig), - MEMBER_TO_FPTR(Perl_magic_setsig), - 0, - MEMBER_TO_FPTR(Perl_magic_clearsig), - 0, - 0, - 0, - 0 -); -#endif - -MGVTBL_SET( - PL_vtbl_pack, - 0, - 0, - MEMBER_TO_FPTR(Perl_magic_sizepack), - MEMBER_TO_FPTR(Perl_magic_wipepack), - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_packelem, - MEMBER_TO_FPTR(Perl_magic_getpack), - MEMBER_TO_FPTR(Perl_magic_setpack), - 0, - MEMBER_TO_FPTR(Perl_magic_clearpack), - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_dbline, - 0, - MEMBER_TO_FPTR(Perl_magic_setdbline), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_isa, - 0, - MEMBER_TO_FPTR(Perl_magic_setisa), - 0, - MEMBER_TO_FPTR(Perl_magic_clearisa), - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_isaelem, - 0, - MEMBER_TO_FPTR(Perl_magic_setisa), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET_CONST_MAGIC_GET( - PL_vtbl_arylen, - MEMBER_TO_FPTR(Perl_magic_getarylen), - MEMBER_TO_FPTR(Perl_magic_setarylen), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_arylen_p, - 0, - 0, - 0, - 0, - MEMBER_TO_FPTR(Perl_magic_freearylen_p), - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_mglob, - 0, - MEMBER_TO_FPTR(Perl_magic_setmglob), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_nkeys, - MEMBER_TO_FPTR(Perl_magic_getnkeys), - MEMBER_TO_FPTR(Perl_magic_setnkeys), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_taint, - MEMBER_TO_FPTR(Perl_magic_gettaint), - MEMBER_TO_FPTR(Perl_magic_settaint), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_substr, - MEMBER_TO_FPTR(Perl_magic_getsubstr), - MEMBER_TO_FPTR(Perl_magic_setsubstr), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_vec, - MEMBER_TO_FPTR(Perl_magic_getvec), - MEMBER_TO_FPTR(Perl_magic_setvec), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_pos, - MEMBER_TO_FPTR(Perl_magic_getpos), - MEMBER_TO_FPTR(Perl_magic_setpos), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_bm, - 0, - MEMBER_TO_FPTR(Perl_magic_setregexp), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_fm, - 0, - MEMBER_TO_FPTR(Perl_magic_setregexp), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_uvar, - MEMBER_TO_FPTR(Perl_magic_getuvar), - MEMBER_TO_FPTR(Perl_magic_setuvar), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_defelem, - MEMBER_TO_FPTR(Perl_magic_getdefelem), - MEMBER_TO_FPTR(Perl_magic_setdefelem), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_regexp, - 0, - MEMBER_TO_FPTR(Perl_magic_setregexp), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_regdata, - 0, - 0, - MEMBER_TO_FPTR(Perl_magic_regdata_cnt), - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_regdatum, - MEMBER_TO_FPTR(Perl_magic_regdatum_get), - MEMBER_TO_FPTR(Perl_magic_regdatum_set), - 0, - 0, - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_amagic, - 0, - MEMBER_TO_FPTR(Perl_magic_setamagic), - 0, - 0, - MEMBER_TO_FPTR(Perl_magic_setamagic), - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_amagicelem, - 0, - MEMBER_TO_FPTR(Perl_magic_setamagic), - 0, - 0, - MEMBER_TO_FPTR(Perl_magic_setamagic), - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_backref, - 0, - 0, - 0, - 0, - MEMBER_TO_FPTR(Perl_magic_killbackrefs), - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_ovrld, - 0, - 0, - 0, - 0, - MEMBER_TO_FPTR(Perl_magic_freeovrld), - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_utf8, - 0, - MEMBER_TO_FPTR(Perl_magic_setutf8), - 0, - 0, - 0, - 0, - 0, - 0 -); -#ifdef USE_LOCALE_COLLATE -MGVTBL_SET( - PL_vtbl_collxfrm, - 0, - MEMBER_TO_FPTR(Perl_magic_setcollxfrm), - 0, - 0, - 0, - 0, - 0, - 0 -); -#endif - -MGVTBL_SET( - PL_vtbl_hintselem, - 0, - MEMBER_TO_FPTR(Perl_magic_sethint), - 0, - MEMBER_TO_FPTR(Perl_magic_clearhint), - 0, - 0, - 0, - 0 -); - -MGVTBL_SET( - PL_vtbl_hints, - 0, - 0, - 0, - MEMBER_TO_FPTR(Perl_magic_clearhints), - 0, - 0, - 0, - 0 -); +EXTCONST U8 PL_magic_data[256]; +#endif #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; }; @@ -5571,7 +5177,7 @@ typedef struct am_table_short AMTS; #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_NOSUBS 0x800 /* Including evals that generate no subroutines */ #define PERLDBf_SAVESRC_INVALID 0x1000 /* Save source that did not compile */ #define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB)) @@ -5802,98 +5408,72 @@ typedef struct am_table_short AMTS; #if defined(PERL_IMPLICIT_CONTEXT) -#ifdef PERL_GLOBAL_STRUCT_PRIVATE - -/* This must appear in all extensions that define a my_cxt_t structure, +/* START_MY_CXT 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 -#define MY_CXT_INDEX Perl_my_cxt_index(aTHX_ MY_CXT_KEY) +# ifdef PERL_GLOBAL_STRUCT_PRIVATE +# define START_MY_CXT +# define MY_CXT_INDEX Perl_my_cxt_index(aTHX_ MY_CXT_KEY) +# define MY_CXT_INIT_ARG MY_CXT_KEY +# else +# define START_MY_CXT static int my_cxt_index = -1; +# define MY_CXT_INDEX my_cxt_index +# define MY_CXT_INIT_ARG &my_cxt_index +# endif /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */ /* 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 \ +# define MY_CXT_INIT \ my_cxt_t *my_cxtp = \ - (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_KEY, sizeof(my_cxt_t)) -#define MY_CXT_INIT_INTERP(my_perl) \ + (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_INIT_ARG, 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_KEY, sizeof(my_cxt_t)) + (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_INIT_ARG, sizeof(my_cxt_t)) /* This declaration should be used within all functions that use the * interpreter-local data. */ -#define dMY_CXT \ +# define dMY_CXT \ my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[MY_CXT_INDEX] -#define dMY_CXT_INTERP(my_perl) \ +# define dMY_CXT_INTERP(my_perl) \ my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[MY_CXT_INDEX] /* Clones the per-interpreter data. */ -#define MY_CXT_CLONE \ +# define MY_CXT_CLONE \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ Copy(PL_my_cxt_list[MY_CXT_INDEX], my_cxtp, 1, my_cxt_t);\ PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp \ -#else /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */ - -/* 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 static int my_cxt_index = -1; - -/* This declaration should be used within all functions that use the - * interpreter-local data. */ -#define dMY_CXT \ - 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 \ - 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 \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - Copy(PL_my_cxt_list[my_cxt_index], my_cxtp, 1, my_cxt_t);\ - PL_my_cxt_list[my_cxt_index] = my_cxtp \ - -#endif /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */ /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ -#define MY_CXT (*my_cxtp) +# define MY_CXT (*my_cxtp) /* Judicious use of these macros can reduce the number of times dMY_CXT * is used. Use is similar to pTHX, aTHX etc. */ -#define pMY_CXT my_cxt_t *my_cxtp -#define pMY_CXT_ pMY_CXT, -#define _pMY_CXT ,pMY_CXT -#define aMY_CXT my_cxtp -#define aMY_CXT_ aMY_CXT, -#define _aMY_CXT ,aMY_CXT +# define pMY_CXT my_cxt_t *my_cxtp +# define pMY_CXT_ pMY_CXT, +# define _pMY_CXT ,pMY_CXT +# define aMY_CXT my_cxtp +# define aMY_CXT_ aMY_CXT, +# define _aMY_CXT ,aMY_CXT #else /* PERL_IMPLICIT_CONTEXT */ -#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 - -#define pMY_CXT void -#define pMY_CXT_ -#define _pMY_CXT -#define aMY_CXT -#define aMY_CXT_ -#define _aMY_CXT +# 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 + +# define pMY_CXT void +# define pMY_CXT_ +# define _pMY_CXT +# define aMY_CXT +# define aMY_CXT_ +# define _aMY_CXT #endif /* !defined(PERL_IMPLICIT_CONTEXT) */ @@ -5970,6 +5550,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? */ @@ -6059,36 +5641,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)) @@ -6129,6 +5681,7 @@ extern void moncontrol(int); #define PERL_PV_ESCAPE_UNI 0x0100 #define PERL_PV_ESCAPE_UNI_DETECT 0x0200 +#define PERL_PV_ESCAPE_NONASCII 0x0400 #define PERL_PV_ESCAPE_ALL 0x1000 #define PERL_PV_ESCAPE_NOBACKSLASH 0x2000 @@ -6139,7 +5692,15 @@ extern void moncontrol(int); /* used by pv_display in dump.c*/ #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 +#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII + +#ifdef PERL_CORE +# define FEATURE_IS_ENABLED(name) \ + ((0 != (PL_hints & HINT_LOCALIZE_HH)) \ + && Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name))) +/* The longest string we pass in. */ +# define MAX_FEATURE_LEN (sizeof("unicode_strings")-1) +#endif /*