X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f1fb87419225265377ea1d91eac0dc99547137a6..708dd780e3f616326ace3e976492811791549704:/perl.h diff --git a/perl.h b/perl.h index 25d29aa..8b33633 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 @@ -181,6 +172,7 @@ # define tTHX PerlInterpreter* # define pTHX register tTHX my_perl PERL_UNUSED_DECL # define aTHX my_perl +# define aTHXa(a) aTHX = (tTHX)a # ifdef PERL_GLOBAL_STRUCT # define dTHXa(a) dVAR; pTHX = (tTHX)a # else @@ -359,7 +351,11 @@ /* 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() +#ifdef __cplusplus +#define dNOOP (void)0 +#else +#define dNOOP extern int Perl___notused(void) +#endif #ifndef pTHX /* Don't bother defining tTHX and sTHX; using them outside @@ -369,6 +365,7 @@ # define pTHX_ # define aTHX # define aTHX_ +# define aTHXa(a) NOOP # define dTHXa(a) dNOOP # define dTHX dNOOP # define pTHX_1 1 @@ -491,9 +488,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 @@ -518,7 +512,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); */ /* define this once if either system, instead of cluttering up the src */ -#if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(NETWARE) +#if defined(MSDOS) || defined(WIN32) || defined(NETWARE) #define DOSISH 1 #endif @@ -536,11 +530,54 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # define VOL #endif -#define TAINT (PL_tainted = TRUE) -#define TAINT_NOT (PL_tainted = FALSE) -#define TAINT_IF(c) if (c) { PL_tainted = TRUE; } -#define TAINT_ENV() if (PL_tainting) { taint_env(); } -#define TAINT_PROPER(s) if (PL_tainting) { taint_proper(NULL, s); } +/* By compiling a perl with -DNO_TAINT_SUPPORT or -DSILENT_NO_TAINT_SUPPORT, + * you get a perl without taint support, but doubtlessly with a lesser + * degree of support. Do not do so unless you know exactly what it means + * technically, have a good reason to do so, and know exactly how the + * perl will be used. perls with -DSILENT_NO_TAINT_SUPPORT are considered + * a potential security risk due to flat out ignoring the security-relevant + * taint flags. This being said, a perl without taint support compiled in + * has marginal run-time performance benefits. + * SILENT_NO_TAINT_SUPPORT implies NO_TAINT_SUPPORT. + * SILENT_NO_TAINT_SUPPORT is the same as NO_TAINT_SUPPORT except it + * silently ignores -t/-T instead of throwing an exception. + * + * DANGER! Using NO_TAINT_SUPPORT or SILENT_NO_TAINT_SUPPORT + * voids your nonexistent warranty! + */ +#if SILENT_NO_TAINT_SUPPORT && !defined(NO_TAINT_SUPPORT) +# define NO_TAINT_SUPPORT 1 +#endif + +/* NO_TAINT_SUPPORT can be set to transform virtually all taint-related + * operations into no-ops for a very modest speed-up. Enable only if you + * know what you're doing: tests and CPAN modules' tests are bound to fail. + */ +#if NO_TAINT_SUPPORT +# define TAINT NOOP +# define TAINT_NOT NOOP +# define TAINT_IF(c) NOOP +# define TAINT_ENV() NOOP +# define TAINT_PROPER(s) NOOP +# define TAINT_set(s) NOOP +# define TAINT_get 0 +# define TAINTING_get 0 +# define TAINTING_set(s) NOOP +# define TAINT_WARN_get 0 +# define TAINT_WARN_set(s) NOOP +#else +# define TAINT (PL_tainted = TRUE) +# define TAINT_NOT (PL_tainted = FALSE) +# define TAINT_IF(c) if (c) { PL_tainted = TRUE; } +# define TAINT_ENV() if (PL_tainting) { taint_env(); } +# define TAINT_PROPER(s) if (PL_tainting) { taint_proper(NULL, s); } +# define TAINT_set(s) (PL_tainted = (s)) +# define TAINT_get (PL_tainted) +# define TAINTING_get (PL_tainting) +# define TAINTING_set(s) (PL_tainting = (s)) +# define TAINT_WARN_get (PL_taint_warn) +# define TAINT_WARN_set(s) (PL_taint_warn = (s)) +#endif /* flags used internally only within pp_subst and pp_substcont */ #ifdef PERL_CORE @@ -737,6 +774,8 @@ EXTERN_C int usleep(unsigned int); # define U64_CONST(x) ((U64)x##UL) # elif QUADKIND == QUAD_IS_LONG_LONG # define U64_CONST(x) ((U64)x##ULL) +# elif QUADKIND == QUAD_IS___INT64 +# define U64_CONST(x) ((U64)x##UI64) # else /* best guess we can make */ # define U64_CONST(x) ((U64)x##UL) # endif @@ -977,17 +1016,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 @@ -1189,7 +1217,7 @@ EXTERN_C int usleep(unsigned int); # define S_IFIFO _S_IFIFO #endif -/* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives +/* The stat macros for Unisoft System V/88 (and derivatives like UTekV) are broken, sometimes giving false positives. Undefine them here and let the code below set them to proper values. @@ -1198,7 +1226,7 @@ EXTERN_C int usleep(unsigned int); This header file bug is corrected in gcc-2.5.8 and later versions. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94. */ -#if defined(uts) || (defined(m88k) && defined(ghs)) +#if defined(m88k) && defined(ghs) # undef S_ISDIR # undef S_ISCHR # undef S_ISBLK @@ -1243,7 +1271,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) @@ -1369,11 +1397,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 */ @@ -1386,13 +1423,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 @@ -1632,10 +1669,6 @@ EXTERN_C char *crypt(const char *, const char *); #undef UV #endif -#ifdef SPRINTF_E_BUG -# define sprintf UTS_sprintf_wrap -#endif - /* For the times when you want the return value of sprintf, and you want it to be the length. Can't have a thread variable passed in, because C89 has no varargs macros. @@ -1698,13 +1731,6 @@ EXTERN_C char *crypt(const char *, const char *); # define my_strlcpy Perl_my_strlcpy #endif -/* Configure gets this right but the UTS compiler gets it wrong. - -- Hal Morris */ -#ifdef UTS -# undef UVTYPE -# define UVTYPE unsigned -#endif - /* The IV type is supposed to be long enough to hold any integral value or a pointer. @@ -1770,11 +1796,6 @@ typedef UVTYPE UV; # undef PERL_NEED_MY_BETOH64 #endif -#if defined(uts) || defined(UTS) -# undef UV_MAX -# define UV_MAX (4294967295u) -#endif - #define IV_DIG (BIT_DIGITS(IVSIZE * 8)) #define UV_DIG (BIT_DIGITS(UVSIZE * 8)) @@ -2419,14 +2440,18 @@ 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; typedef struct interpreter PerlInterpreter; -/* Amdahl's has struct sv */ /* SGI's has struct sv */ -#if defined(UTS) || defined(__sgi) +#if defined(__sgi) # define STRUCT_SV perl_sv #else # define STRUCT_SV sv @@ -2462,6 +2487,13 @@ typedef struct ptr_tbl_ent PTR_TBL_ENT_t; typedef struct ptr_tbl PTR_TBL_t; typedef struct clone_params CLONE_PARAMS; +/* a pad or name pad is currently just an AV; but that might change, + * so hide the type. */ +typedef struct padlist PADLIST; +typedef AV PAD; +typedef AV PADNAMELIST; +typedef SV PADNAME; + #include "handy.h" #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) @@ -2568,11 +2600,6 @@ typedef struct clone_params CLONE_PARAMS; # include "iperlsys.h" #endif -#if defined(__OPEN_VM) -# include "vmesa/vmesaish.h" -# define ISHISH "vmesa" -#endif - #ifdef DOSISH # if defined(OS2) # include "os2ish.h" @@ -2584,11 +2611,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 @@ -2597,11 +2619,6 @@ typedef struct clone_params CLONE_PARAMS; # define ISHISH "plan9" #endif -#if defined(MPE) -# include "mpeix/mpeixish.h" -# define ISHISH "mpeix" -#endif - #if defined(__VOS__) # ifdef __GNUC__ # include "./vos/vosish.h" @@ -2618,11 +2635,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 @@ -2736,12 +2748,12 @@ typedef struct clone_params CLONE_PARAMS; #endif /* -=for apidoc Am|void|PERL_SYS_INIT|int argc|char** argv +=for apidoc Am|void|PERL_SYS_INIT|int *argc|char*** argv Provides system-specific tune up of the C runtime environment necessary to run Perl interpreters. This should be called only once, before creating any Perl interpreters. -=for apidoc Am|void|PERL_SYS_INIT3|int argc|char** argv|char** env +=for apidoc Am|void|PERL_SYS_INIT3|int *argc|char*** argv|char*** env Provides system-specific tune up of the C runtime environment necessary to run Perl interpreters. This should be called only once, before creating any Perl interpreters. @@ -2779,11 +2791,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 @@ -3211,6 +3219,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 @@ -3284,9 +3304,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 */ @@ -3471,8 +3491,7 @@ struct _sublex_info { U8 super_state; /* lexer state to save */ U16 sub_inwhat; /* "lex_inwhat" to use */ OP *sub_op; /* "lex_op" to use */ - char *super_bufptr; /* PL_parser->bufptr that was */ - char *super_bufend; /* PL_parser->bufend that was */ + SV *repl; /* replacement of s/// or y/// */ }; #include "parser.h" @@ -3497,10 +3516,6 @@ struct ptr_tbl { struct ptr_tbl_ent *tbl_arena_end; }; -#if defined(iAPX286) || defined(M_I286) || defined(I80286) -# define I286 -#endif - #if defined(htonl) && !defined(HAS_HTONL) #define HAS_HTONL #endif @@ -3626,7 +3641,7 @@ long vtohl(long n); #endif #ifndef __cplusplus -#if !(defined(UNDER_CE) || defined(SYMBIAN)) +#if !(defined(WIN32) || defined(UNDER_CE) || defined(SYMBIAN)) Uid_t getuid (void); Uid_t geteuid (void); Gid_t getgid (void); @@ -3665,7 +3680,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 */ @@ -3675,7 +3690,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 @@ -3697,6 +3712,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) @@ -3728,6 +3744,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_ @@ -3779,6 +3796,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) @@ -3806,6 +3824,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) @@ -3837,6 +3856,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) @@ -3873,6 +3893,11 @@ Gid_t getegid (void); #ifndef assert # define assert(what) Perl_assert(what) #endif +#ifdef DEBUGGING +# define assert_(what) assert(what), +#else +# define assert_(what) +#endif struct ufuncs { I32 (*uf_val)(pTHX_ IV, SV*); @@ -3914,7 +3939,7 @@ double atof (const char*); /* All of these are in stdlib.h or time.h for ANSI C */ Time_t time(); struct tm *gmtime(), *localtime(); -#if defined(OEMVS) || defined(__OPEN_VM) +#if defined(OEMVS) char *(strchr)(), *(strrchr)(); char *(strcpy)(), *(strcat)(); #else @@ -4013,9 +4038,11 @@ Off_t lseek (int,Off_t,int); # endif # endif # endif /* !DONT_DECLARE_STD */ -#ifndef getlogin +# ifndef WIN32 +# ifndef getlogin char *getlogin (void); -#endif +# endif +# endif /* !WIN32 */ #endif /* !__cplusplus */ /* Fixme on VMS. This needs to be a run-time, not build time options */ @@ -4218,6 +4245,8 @@ 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[] @@ -4292,10 +4321,18 @@ EXTCONST char PL_uuemap[65] #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 }; @@ -4592,7 +4629,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", @@ -4611,7 +4650,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 @@ -4629,12 +4667,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 @@ -4650,6 +4700,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 @@ -4668,12 +4721,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 @@ -4689,6 +4736,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 @@ -4707,12 +4760,12 @@ EXTCONST char PL_bincompat_options[] = # ifdef VMS_DO_SOCKETS " VMS_DO_SOCKETS" # 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[]; @@ -4755,6 +4808,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 @@ -4796,9 +4851,11 @@ typedef enum { #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 */ @@ -4825,12 +4882,26 @@ typedef enum { #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 #define HINT_SORT_MERGESORT 0x00000002 #define HINT_SORT_STABLE 0x00000100 /* sort styles (currently one) */ +/* flags for PL_sawampersand */ + +#define SAWAMPERSAND_LEFT 1 /* saw $` */ +#define SAWAMPERSAND_MIDDLE 2 /* saw $& */ +#define SAWAMPERSAND_RIGHT 4 /* saw $' */ + /* Various states of the input record separator SV (rs) */ #define RsSNARF(sv) (! SvOK(sv)) #define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv))) @@ -4879,6 +4950,8 @@ 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 @@ -4914,10 +4987,10 @@ struct 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; +# 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" @@ -4985,6 +5058,24 @@ 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 + +/* PERL_STATIC_NO_RET is supposed to be equivalent to STATIC on builds that + dont have a noreturn as a declaration specifier +*/ +#ifndef PERL_STATIC_NO_RET +# define PERL_STATIC_NO_RET STATIC +#endif +/* PERL_STATIC_NO_RET is supposed to be equivalent to PERL_STATIC_INLINE on + builds that dont have a noreturn as a declaration specifier +*/ +#ifndef PERL_STATIC_INLINE_NO_RET +# define PERL_STATIC_INLINE_NO_RET PERL_STATIC_INLINE +#endif + + #undef PERL_CKDEF #undef PERL_PPDEF #define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o); @@ -5016,10 +5107,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 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 @@ -5032,13 +5123,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 @@ -5085,7 +5176,11 @@ EXTCONST runops_proc_t PL_runops_dbg #ifdef DOINIT EXTCONST U8 PL_magic_data[256] = -#include "mg_data.h" +# ifdef PERL_MICRO +# include "umg_data.h" +# else +# include "mg_data.h" +# endif ; #else EXTCONST U8 PL_magic_data[256]; @@ -5098,7 +5193,7 @@ 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 }; +PL_valid_types_PVX[] = { 0, 0, 0, 0, 1, 1, 1, 1, 0, 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 @@ -5117,6 +5212,8 @@ EXTCONST bool PL_valid_types_NV_set[]; #endif +/* Static inline funcs that depend on includes and declarations above */ +#include "inline.h" #include "overload.h" @@ -5127,7 +5224,6 @@ struct am_table { U8 fallback; U16 spare; U32 was_ok_sub; - long was_ok_am; CV* table[NofAMmeth]; }; struct am_table_short { @@ -5135,7 +5231,6 @@ struct am_table_short { U8 fallback; U16 spare; U32 was_ok_sub; - long was_ok_am; }; typedef struct am_table AMT; typedef struct am_table_short AMTS; @@ -5229,11 +5324,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; \ @@ -5262,10 +5369,12 @@ typedef struct am_table_short AMTS; #define RESTORE_NUMERIC_STANDARD() /**/ #define Atof my_atof #define IN_LOCALE_RUNTIME 0 +#define IN_LOCALE_COMPILETIME 0 #endif /* !USE_LOCALE_NUMERIC */ -#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG +#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \ + (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) # ifdef __hpux # define strtoll __strtoll /* secret handshake */ # endif @@ -5287,7 +5396,8 @@ typedef struct am_table_short AMTS; /* It would be more fashionable to use Strtol() to define atol() * (as is done for Atoul(), see below) but for backward compatibility * we just assume atol(). */ -# if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_ATOLL) +# if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && defined(HAS_ATOLL) && \ + (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) # ifdef WIN64 # define atoll _atoi64 /* secret handshake */ # endif @@ -5297,7 +5407,8 @@ typedef struct am_table_short AMTS; # endif #endif -#if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG +#if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && \ + (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64) # ifdef __hpux # define strtoull __strtoull /* secret handshake */ # endif @@ -5453,10 +5564,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. */ @@ -5473,7 +5586,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 @@ -5596,15 +5709,7 @@ extern void moncontrol(int); /* ISO 6429 NEL - C1 control NExt Line */ /* See http://www.unicode.org/unicode/reports/tr13/ */ -#ifdef EBCDIC /* In EBCDIC NEL is just an alias for LF */ -# if '^' == 95 /* CP 1047: MVS OpenEdition - OS/390 - z/OS */ -# define NEXT_LINE_CHAR 0x15 -# else /* CDRA */ -# define NEXT_LINE_CHAR 0x25 -# endif -#else -# define NEXT_LINE_CHAR 0x85 -#endif +#define NEXT_LINE_CHAR NEXT_LINE_NATIVE /* The UTF-8 bytes of the Unicode LS and PS, U+2028 and U+2029 */ #define UNICODE_LINE_SEPA_0 0xE2 @@ -5721,14 +5826,6 @@ extern void moncontrol(int); #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|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 - /* (KEEP THIS LAST IN perl.h!) @@ -5785,8 +5882,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: */