X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e2d73a187ae89e218e7afbba96e00e1370ab2240..d80134284328cd5128b0a17920632e7b70625b46:/perl.h diff --git a/perl.h b/perl.h index e7ab45f..1f6e4e4 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 @@ -100,8 +91,8 @@ /* Any stack-challenged places. The limit varies (and often * is configurable), but using more than a kilobyte of stack * is usually dubious in these systems. */ -#if defined(EPOC) || defined(__SYMBIAN32__) -/* EPOC/Symbian: need to work around the SDK features. * +#if defined(__SYMBIAN32__) +/* Symbian: need to work around the SDK features. * * On WINS: MS VC5 generates calls to _chkstk, * * if a "large" stack frame is allocated. * * gcc on MARM does not generate calls like these. */ @@ -166,7 +157,7 @@ # endif #endif -#define pVAR register struct perl_vars* my_vars PERL_UNUSED_DECL +#define pVAR struct perl_vars* my_vars PERL_UNUSED_DECL #ifdef PERL_GLOBAL_STRUCT # define dVAR pVAR = (struct perl_vars*)PERL_GET_VARS() @@ -179,8 +170,9 @@ # define MULTIPLICITY # endif # define tTHX PerlInterpreter* -# define pTHX register tTHX my_perl PERL_UNUSED_DECL +# define pTHX 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. */ +#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 @@ -397,7 +394,7 @@ #endif #ifndef pTHXx -# define pTHXx register PerlInterpreter *my_perl +# define pTHXx PerlInterpreter *my_perl # define pTHXx_ pTHXx, # define aTHXx my_perl # define aTHXx_ aTHXx, @@ -445,7 +442,7 @@ # ifdef __GNUC__ # define stringify_immed(s) #s # define stringify(s) stringify_immed(s) -register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); +struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # endif #endif @@ -515,15 +512,15 @@ 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 -#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(EPOC) || defined(NETWARE) || defined(__SYMBIAN32__) +#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(NETWARE) || defined(__SYMBIAN32__) # define STANDARD_C 1 #endif -#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined(EPOC) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO) +#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO) # define DONT_DECLARE_STD 1 #endif @@ -533,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 (UNLIKELY(c)) { PL_tainted = TRUE; } +# define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); } +# define TAINT_PROPER(s) if (UNLIKELY(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 @@ -703,15 +743,6 @@ EXTERN_C int syscall(int, ...); EXTERN_C int usleep(unsigned int); #endif -/* Funky places that do not have socket stuff. */ -#if defined(__LIBCATAMOUNT__) -# define MYSWAP -#endif - -#ifdef PERL_MICRO /* Last chance to export Perl_my_swap */ -# define MYSWAP -#endif - #ifdef PERL_CORE /* macros for correct constant construction */ @@ -734,6 +765,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 @@ -762,189 +795,6 @@ EXTERN_C int usleep(unsigned int); (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) )) # endif -/*----------------------------------------------------------------------------*/ -# if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 /* little-endian */ -/*----------------------------------------------------------------------------*/ -# define my_htole16(x) (x) -# define my_letoh16(x) (x) -# define my_htole32(x) (x) -# define my_letoh32(x) (x) -# define my_htobe16(x) _swab_16_(x) -# define my_betoh16(x) _swab_16_(x) -# define my_htobe32(x) _swab_32_(x) -# define my_betoh32(x) _swab_32_(x) -# ifdef HAS_QUAD -# define my_htole64(x) (x) -# define my_letoh64(x) (x) -# define my_htobe64(x) _swab_64_(x) -# define my_betoh64(x) _swab_64_(x) -# endif -# define my_htoles(x) (x) -# define my_letohs(x) (x) -# define my_htolei(x) (x) -# define my_letohi(x) (x) -# define my_htolel(x) (x) -# define my_letohl(x) (x) -# if SHORTSIZE == 1 -# define my_htobes(x) (x) -# define my_betohs(x) (x) -# elif SHORTSIZE == 2 -# define my_htobes(x) _swab_16_(x) -# define my_betohs(x) _swab_16_(x) -# elif SHORTSIZE == 4 -# define my_htobes(x) _swab_32_(x) -# define my_betohs(x) _swab_32_(x) -# elif SHORTSIZE == 8 -# define my_htobes(x) _swab_64_(x) -# define my_betohs(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOBES -# define PERL_NEED_MY_BETOHS -# endif -# if INTSIZE == 1 -# define my_htobei(x) (x) -# define my_betohi(x) (x) -# elif INTSIZE == 2 -# define my_htobei(x) _swab_16_(x) -# define my_betohi(x) _swab_16_(x) -# elif INTSIZE == 4 -# define my_htobei(x) _swab_32_(x) -# define my_betohi(x) _swab_32_(x) -# elif INTSIZE == 8 -# define my_htobei(x) _swab_64_(x) -# define my_betohi(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOBEI -# define PERL_NEED_MY_BETOHI -# endif -# if LONGSIZE == 1 -# define my_htobel(x) (x) -# define my_betohl(x) (x) -# elif LONGSIZE == 2 -# define my_htobel(x) _swab_16_(x) -# define my_betohl(x) _swab_16_(x) -# elif LONGSIZE == 4 -# define my_htobel(x) _swab_32_(x) -# define my_betohl(x) _swab_32_(x) -# elif LONGSIZE == 8 -# define my_htobel(x) _swab_64_(x) -# define my_betohl(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOBEL -# define PERL_NEED_MY_BETOHL -# endif -# define my_htolen(p,n) NOOP -# define my_letohn(p,n) NOOP -# define my_htoben(p,n) my_swabn(p,n) -# define my_betohn(p,n) my_swabn(p,n) -/*----------------------------------------------------------------------------*/ -# elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 /* big-endian */ -/*----------------------------------------------------------------------------*/ -# define my_htobe16(x) (x) -# define my_betoh16(x) (x) -# define my_htobe32(x) (x) -# define my_betoh32(x) (x) -# define my_htole16(x) _swab_16_(x) -# define my_letoh16(x) _swab_16_(x) -# define my_htole32(x) _swab_32_(x) -# define my_letoh32(x) _swab_32_(x) -# ifdef HAS_QUAD -# define my_htobe64(x) (x) -# define my_betoh64(x) (x) -# define my_htole64(x) _swab_64_(x) -# define my_letoh64(x) _swab_64_(x) -# endif -# define my_htobes(x) (x) -# define my_betohs(x) (x) -# define my_htobei(x) (x) -# define my_betohi(x) (x) -# define my_htobel(x) (x) -# define my_betohl(x) (x) -# if SHORTSIZE == 1 -# define my_htoles(x) (x) -# define my_letohs(x) (x) -# elif SHORTSIZE == 2 -# define my_htoles(x) _swab_16_(x) -# define my_letohs(x) _swab_16_(x) -# elif SHORTSIZE == 4 -# define my_htoles(x) _swab_32_(x) -# define my_letohs(x) _swab_32_(x) -# elif SHORTSIZE == 8 -# define my_htoles(x) _swab_64_(x) -# define my_letohs(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOLES -# define PERL_NEED_MY_LETOHS -# endif -# if INTSIZE == 1 -# define my_htolei(x) (x) -# define my_letohi(x) (x) -# elif INTSIZE == 2 -# define my_htolei(x) _swab_16_(x) -# define my_letohi(x) _swab_16_(x) -# elif INTSIZE == 4 -# define my_htolei(x) _swab_32_(x) -# define my_letohi(x) _swab_32_(x) -# elif INTSIZE == 8 -# define my_htolei(x) _swab_64_(x) -# define my_letohi(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOLEI -# define PERL_NEED_MY_LETOHI -# endif -# if LONGSIZE == 1 -# define my_htolel(x) (x) -# define my_letohl(x) (x) -# elif LONGSIZE == 2 -# define my_htolel(x) _swab_16_(x) -# define my_letohl(x) _swab_16_(x) -# elif LONGSIZE == 4 -# define my_htolel(x) _swab_32_(x) -# define my_letohl(x) _swab_32_(x) -# elif LONGSIZE == 8 -# define my_htolel(x) _swab_64_(x) -# define my_letohl(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOLEL -# define PERL_NEED_MY_LETOHL -# endif -# define my_htolen(p,n) my_swabn(p,n) -# define my_letohn(p,n) my_swabn(p,n) -# define my_htoben(p,n) NOOP -# define my_betohn(p,n) NOOP -/*----------------------------------------------------------------------------*/ -# else /* all other byte-orders */ -/*----------------------------------------------------------------------------*/ -# define PERL_NEED_MY_HTOLE16 -# define PERL_NEED_MY_LETOH16 -# define PERL_NEED_MY_HTOBE16 -# define PERL_NEED_MY_BETOH16 -# define PERL_NEED_MY_HTOLE32 -# define PERL_NEED_MY_LETOH32 -# define PERL_NEED_MY_HTOBE32 -# define PERL_NEED_MY_BETOH32 -# ifdef HAS_QUAD -# define PERL_NEED_MY_HTOLE64 -# define PERL_NEED_MY_LETOH64 -# define PERL_NEED_MY_HTOBE64 -# define PERL_NEED_MY_BETOH64 -# endif -# define PERL_NEED_MY_HTOLES -# define PERL_NEED_MY_LETOHS -# define PERL_NEED_MY_HTOBES -# define PERL_NEED_MY_BETOHS -# define PERL_NEED_MY_HTOLEI -# define PERL_NEED_MY_LETOHI -# define PERL_NEED_MY_HTOBEI -# define PERL_NEED_MY_BETOHI -# define PERL_NEED_MY_HTOLEL -# define PERL_NEED_MY_LETOHL -# define PERL_NEED_MY_HTOBEL -# define PERL_NEED_MY_BETOHL -/*----------------------------------------------------------------------------*/ -# endif /* end of byte-order macros */ -/*----------------------------------------------------------------------------*/ - /* The old value was hard coded at 1008. (4096-16) seems to be a bit faster, at least on FreeBSD. YMMV, so experiment. */ #ifndef PERL_ARENA_SIZE @@ -970,21 +820,10 @@ EXTERN_C int usleep(unsigned int); #define PERL_USES_PL_PIDSTATUS #endif -#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) +#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(__SYMBIAN32__) #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 @@ -1186,7 +1025,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. @@ -1195,7 +1034,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 @@ -1240,7 +1079,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) @@ -1366,11 +1205,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 */ @@ -1383,13 +1231,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 @@ -1601,15 +1449,15 @@ EXTERN_C char *crypt(const char *, const char *); # define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) #endif -/* BeOS 5.0 and Haiku R1 seem to define S_IREAD and S_IWRITE in +/* Haiku R1 seems to define S_IREAD and S_IWRITE in * which would get included through , but that is 3000 * lines in the future. --jhi */ -#if !defined(S_IREAD) && !(defined(__BEOS__) || defined(__HAIKU__)) +#if !defined(S_IREAD) && !defined(__HAIKU__) # define S_IREAD S_IRUSR #endif -#if !defined(S_IWRITE) && !(defined(__BEOS__) || defined(__HAIKU__)) +#if !defined(S_IWRITE) && !defined(__HAIKU__) # define S_IWRITE S_IWUSR #endif @@ -1629,10 +1477,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. @@ -1673,7 +1517,7 @@ EXTERN_C char *crypt(const char *, const char *); #if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) # ifdef PERL_USE_GCC_BRACE_GROUPS -# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; }) +# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (Size_t)(len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; }) # define PERL_MY_VSNPRINTF_GUARDED # else # define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__) @@ -1695,13 +1539,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. @@ -1767,11 +1604,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)) @@ -2416,14 +2248,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 @@ -2459,6 +2295,29 @@ 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; + +/* XXX for 5.18, disable the COW by default + * #if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW) + * # define PERL_NEW_COPY_ON_WRITE + * #endif + */ + +#if defined(PERL_OLD_COPY_ON_WRITE) || defined(PERL_NEW_COPY_ON_WRITE) +# if defined(PERL_OLD_COPY_ON_WRITE) && defined(PERL_NEW_COPY_ON_WRITE) +# error PERL_OLD_COPY_ON_WRITE and PERL_NEW_COPY_ON_WRITE are exclusive +# else +# define PERL_ANY_COW +# endif +#else +# define PERL_SAWAMPERSAND +#endif + #include "handy.h" #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) @@ -2565,11 +2424,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" @@ -2581,11 +2435,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 @@ -2594,11 +2443,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" @@ -2608,18 +2452,8 @@ typedef struct clone_params CLONE_PARAMS; # define ISHISH "vos" #endif -#if defined(EPOC) -# include "epocish.h" -# define ISHISH "epoc" -#endif - #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 @@ -2627,9 +2461,6 @@ typedef struct clone_params CLONE_PARAMS; #if defined(__HAIKU__) # include "haiku/haikuish.h" # define ISHISH "haiku" -#elif defined(__BEOS__) -# include "beos/beosish.h" -# define ISHISH "beos" #endif #ifndef ISHISH @@ -2733,12 +2564,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. @@ -2776,11 +2607,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 @@ -2843,9 +2670,6 @@ freeing any remaining Perl interpreters. # ifdef NETWARE # include # else -# ifdef FAKE_THREADS -# include "fakethr.h" -# else # ifdef WIN32 # include # else @@ -2872,8 +2696,7 @@ typedef pthread_key_t perl_key; # endif /* I_MACH_CTHREADS */ # endif /* OS2 */ # endif /* WIN32 */ -# endif /* FAKE_THREADS */ -#endif /* NETWARE */ +# endif /* NETWARE */ #endif /* USE_ITHREADS */ #if defined(WIN32) @@ -3208,6 +3031,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 @@ -3281,9 +3116,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 */ @@ -3298,8 +3133,8 @@ typedef pthread_key_t perl_key; #else # define EXPECT(expr,val) (expr) #endif -#define LIKELY(cond) EXPECT(cond,1) -#define UNLIKELY(cond) EXPECT(cond,0) +#define LIKELY(cond) EXPECT(cBOOL(cond),TRUE) +#define UNLIKELY(cond) EXPECT(cBOOL(cond),FALSE) #ifdef HAS_BUILTIN_CHOOSE_EXPR /* placeholder */ #endif @@ -3468,8 +3303,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" @@ -3494,10 +3328,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 @@ -3511,36 +3341,70 @@ struct ptr_tbl { #define HAS_NTOHS #endif #ifndef HAS_HTONL -#if (BYTEORDER & 0xffff) != 0x4321 #define HAS_HTONS #define HAS_HTONL #define HAS_NTOHS #define HAS_NTOHL -#define MYSWAP -#define htons my_swap -#define htonl my_htonl -#define ntohs my_swap -#define ntohl my_ntohl -#endif -#else -#if (BYTEORDER & 0xffff) == 0x4321 -#undef HAS_HTONS -#undef HAS_HTONL -#undef HAS_NTOHS -#undef HAS_NTOHL -#endif +# if (BYTEORDER & 0xffff) == 0x4321 +/* Big endian system, so ntohl, ntohs, htonl and htons do not need to + re-order their values. However, to behave identically to the alternative + implementations, they should truncate to the correct size. */ +# define ntohl(x) ((x)&0xFFFFFFFF) +# define htonl(x) ntohl(x) +# define ntohs(x) ((x)&0xFFFF) +# define htons(x) ntohs(x) +# elif BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 + +/* Note that we can't straight out declare our own htonl and htons because + the Win32 build process forcibly undefines HAS_HTONL etc for its miniperl, + to avoid the overhead of initialising the socket subsystem, but the headers + that *declare* the various functions are still seen. If we declare our own + htonl etc they will clash with the declarations in the Win32 headers. */ + +PERL_STATIC_INLINE U32 +my_swap32(const U32 x) { + return ((x & 0xFF) << 24) | ((x >> 24) & 0xFF) + | ((x & 0x0000FF00) << 8) | ((x & 0x00FF0000) >> 8); +} + +PERL_STATIC_INLINE U16 +my_swap16(const U16 x) { + return ((x & 0xFF) << 8) | ((x >> 8) & 0xFF); +} + +# define htonl(x) my_swap32(x) +# define ntohl(x) my_swap32(x) +# define ntohs(x) my_swap16(x) +# define htons(x) my_swap16(x) +# else +# error "Unsupported byteorder" +/* The C pre-processor doesn't let us return the value of BYTEORDER as part of + the error message. Please check the value of the macro BYTEORDER, as defined + in config.h. The values of BYTEORDER we expect are + + big endian little endian + 32 bit 0x4321 0x1234 + 64 bit 0x87654321 0x12345678 + + If you have a system with a different byte order, please see + pod/perlhack.pod for how to submit a patch to add supporting code. +*/ +# endif #endif /* * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'. * -DWS */ -#if BYTEORDER != 0x1234 -# define HAS_VTOHL -# define HAS_VTOHS -# define HAS_HTOVL -# define HAS_HTOVS -# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 +#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 +/* Little endian system, so vtohl, vtohs, htovl and htovs do not need to + re-order their values. However, to behave identically to the alternative + implementations, they should truncate to the correct size. */ +# define vtohl(x) ((x)&0xFFFFFFFF) +# define vtohs(x) ((x)&0xFFFF) +# define htovl(x) vtohl(x) +# define htovs(x) vtohs(x) +#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 # define vtohl(x) ((((x)&0xFF)<<24) \ +(((x)>>24)&0xFF) \ +(((x)&0x0000FF00)<<8) \ @@ -3548,14 +3412,11 @@ struct ptr_tbl { # define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF)) # define htovl(x) vtohl(x) # define htovs(x) vtohs(x) -# endif - /* otherwise default to functions in util.c */ -#ifndef htovs -short htovs(short n); -short vtohs(short n); -long htovl(long n); -long vtohl(long n); -#endif +#else +# error "Unsupported byteorder" +/* If you have need for current perl on PDP-11 or similar, and can help test + that blead keeps working on a mixed-endian system, then see + pod/perlhack.pod for how to submit patches to things working again. */ #endif /* *MAX Plus 1. A floating point value. @@ -3623,7 +3484,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); @@ -3662,7 +3523,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 */ @@ -3672,7 +3533,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 @@ -3694,6 +3555,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) @@ -3725,6 +3587,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_ @@ -3776,6 +3639,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) @@ -3803,6 +3667,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) @@ -3834,6 +3699,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) @@ -3870,6 +3736,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*); @@ -3911,7 +3782,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 @@ -4002,7 +3873,7 @@ char *crypt (const char*, const char*); # ifndef getenv char *getenv (const char*); # endif /* !getenv */ -# if !defined(HAS_LSEEK_PROTO) && !defined(EPOC) && !defined(__hpux) +# if !defined(HAS_LSEEK_PROTO) && !defined(__hpux) # ifdef _FILE_OFFSET_BITS # if _FILE_OFFSET_BITS == 64 Off_t lseek (int,Off_t,int); @@ -4010,9 +3881,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 */ @@ -4215,6 +4088,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[] @@ -4237,7 +4112,7 @@ EXTCONST char PL_no_helem_sv[] INIT("Modification of non-creatable hash value attempted, subscript \"%"SVf"\""); EXTCONST char PL_no_modify[] INIT("Modification of a read-only value attempted"); -EXTCONST char PL_no_mem[] +EXTCONST char PL_no_mem[sizeof("Out of memory!\n")] INIT("Out of memory!\n"); EXTCONST char PL_no_security[] INIT("Insecure dependency in %s%s"); @@ -4474,8 +4349,10 @@ EXTCONST unsigned char PL_mod_latin1_uc[] = { 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, 255 }; #else /* ! DOINIT */ +#ifndef EBCDIC EXTCONST unsigned char PL_fold[]; EXTCONST unsigned char PL_fold_latin1[]; +#endif EXTCONST unsigned char PL_mod_latin1_uc[]; EXTCONST unsigned char PL_latin1_lc[]; #endif @@ -4597,7 +4474,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", @@ -4616,7 +4495,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 @@ -4631,9 +4509,6 @@ EXTCONST char PL_bincompat_options[] = # ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP " DEBUG_LEAKING_SCALARS_FORK_DUMP" # endif -# ifdef FAKE_THREADS - " FAKE_THREADS" -# endif # ifdef FCRYPT " FCRYPT" # endif @@ -4679,21 +4554,21 @@ EXTCONST char PL_bincompat_options[] = # ifdef PERL_OLD_COPY_ON_WRITE " PERL_OLD_COPY_ON_WRITE" # endif +# ifdef PERL_NEW_COPY_ON_WRITE + " PERL_NEW_COPY_ON_WRITE" +# endif # ifdef PERL_POISON " PERL_POISON" # endif +# ifdef PERL_SAWAMPERSAND + " PERL_SAWAMPERSAND" +# endif # ifdef PERL_TRACK_MEMPOOL " PERL_TRACK_MEMPOOL" # endif # 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 @@ -4781,6 +4656,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 @@ -4822,9 +4699,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 */ @@ -4851,12 +4730,31 @@ 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 $' */ + +#ifndef PERL_SAWAMPERSAND +# define PL_sawampersand \ + (SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT) +#endif + /* Various states of the input record separator SV (rs) */ #define RsSNARF(sv) (! SvOK(sv)) #define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv))) @@ -4905,6 +4803,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 @@ -4941,8 +4841,14 @@ struct interpreter { /* Set up PERLVAR macros for populating structs */ # define PERLVAR(prefix,var,type) type prefix##var; + +/* 'var' is an array of length 'n' */ # define PERLVARA(prefix,var,n,type) type prefix##var[n]; + +/* initialize 'var' to init' */ # define PERLVARI(prefix,var,type,init) type prefix##var; + +/* like PERLVARI, but make 'var' a const */ # define PERLVARIC(prefix,var,type,init) type prefix##var; struct interpreter { @@ -4959,8 +4865,8 @@ EXTCONST U16 PL_interp_size /* 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)); +EXTCONST U16 PL_interp_size_5_18_0 + INIT(PERL_INTERPRETER_SIZE_UPTO_MEMBER(PERL_LAST_5_18_0_INTERP_MEMBER)); # ifdef PERL_GLOBAL_STRUCT @@ -5011,6 +4917,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); @@ -5058,13 +4982,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 @@ -5128,7 +5052,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 @@ -5147,6 +5071,21 @@ EXTCONST bool PL_valid_types_NV_set[]; #endif +#ifndef PERL_NO_INLINE_FUNCTIONS +/* Static inline funcs that depend on includes and declarations above. + Some of these reference functions in the perl object files, and some + compilers aren't smart enough to eliminate unused static inline + functions, so including this file in source code can cause link errors + even if the source code uses none of the functions. Hence including these + can be be suppressed by setting PERL_NO_INLINE_FUNCTIONS. Doing this will + (obviously) result in unworkable XS code, but allows simple probing code + to continue to work, because it permits tests to include the perl headers + for definitions without creating a link dependency on the perl library + (which may not exist yet). +*/ + +# include "inline.h" +#endif #include "overload.h" @@ -5157,7 +5096,6 @@ struct am_table { U8 fallback; U16 spare; U32 was_ok_sub; - long was_ok_am; CV* table[NofAMmeth]; }; struct am_table_short { @@ -5165,7 +5103,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; @@ -5175,13 +5112,9 @@ typedef struct am_table_short AMTS; #define AMGfallYES 3 #define AMTf_AMAGIC 1 -#define AMTf_OVERLOADED 2 #define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC) #define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC) #define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC) -#define AMT_OVERLOADED(amt) ((amt)->flags & AMTf_OVERLOADED) -#define AMT_OVERLOADED_on(amt) ((amt)->flags |= AMTf_OVERLOADED) -#define AMT_OVERLOADED_off(amt) ((amt)->flags &= ~AMTf_OVERLOADED) #define StashHANDLER(stash,meth) gv_handler((stash),CAT2(meth,_amg)) @@ -5259,11 +5192,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; \ @@ -5292,10 +5237,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 @@ -5317,7 +5264,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 @@ -5327,7 +5275,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 @@ -5483,10 +5432,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. */ @@ -5503,7 +5454,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 @@ -5569,10 +5520,9 @@ int flock(int fd, int op); #if O_TEXT != O_BINARY /* If you have different O_TEXT and O_BINARY and you are a CLRF shop, * that is, you are somehow DOSish. */ -# if defined(__BEOS__) || defined(__HAIKU__) || defined(__VOS__) || \ - defined(__CYGWIN__) - /* BeOS/Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect; - * BeOS/Haiku is always UNIXoid (LF), not DOSish (CRLF). */ +# if defined(__HAIKU__) || defined(__VOS__) || defined(__CYGWIN__) + /* Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect; + * Haiku is always UNIXoid (LF), not DOSish (CRLF). */ /* VOS has O_TEXT != O_BINARY, and they have effect, * but VOS always uses LF, never CRLF. */ /* If you have O_TEXT different from your O_BINARY but you still are @@ -5626,15 +5576,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 @@ -5751,14 +5693,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!) @@ -5815,8 +5749,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: */