X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a4eca1d4e93229f61c43cff9ccf327446a06c800..731623ab9836b248099b9e1d42872547270dd8ea:/perl.h diff --git a/perl.h b/perl.h index d711b20..b3b77ba 100644 --- a/perl.h +++ b/perl.h @@ -140,15 +140,15 @@ # ifdef PERL_GLOBAL_STRUCT_PRIVATE EXTERN_C struct perl_vars* Perl_GetVarsPrivate(); # define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */ -# ifndef PERLIO_FUNCS_CONST -# define PERLIO_FUNCS_CONST /* Can't have these lying around. */ -# endif # else # define PERL_GET_VARS() PL_VarsPtr # endif # endif #endif +/* this used to be off by default, now its on, see perlio.h */ +#define PERLIO_FUNCS_CONST + #define pVAR struct perl_vars* my_vars PERL_UNUSED_DECL #ifdef PERL_GLOBAL_STRUCT @@ -309,7 +309,7 @@ #endif #ifndef PERL_UNUSED_DECL -# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus) +# if defined(HASATTRIBUTE_UNUSED) && (!defined(__cplusplus) || (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3))) # define PERL_UNUSED_DECL __attribute__unused__ # else # define PERL_UNUSED_DECL @@ -704,6 +704,15 @@ # endif #endif +/* EVC 4 SDK headers includes a bad definition of MB_CUR_MAX in stdlib.h + which is included from stdarg.h. Bad definition not present in SD 2008 + SDK headers. wince.h is not yet included, so we cant fix this from there + since by then MB_CUR_MAX will be defined from stdlib.h. + cewchar.h includes a correct definition of MB_CUR_MAX and it is copied here + since cewchar.h can't be included this early */ +#if defined(UNDER_CE) && (_MSC_VER < 1300) +# define MB_CUR_MAX 1 +#endif #ifdef I_STDARG # include #else @@ -758,6 +767,10 @@ # endif #endif /* !NO_LOCALE && HAS_SETLOCALE */ +/* Is $^ENCODING set, or are we under the encoding pragma? */ +#define IN_ENCODING UNLIKELY(PL_encoding \ + || (PL_lex_encoding && _get_encoding() != NULL)) + #include #ifdef I_SYS_PARAM @@ -1128,14 +1141,6 @@ EXTERN_C int usleep(unsigned int); # define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */ #endif -/* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one. - * This is important for using IPv6. - * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be - * a bad idea since it breaks send() and recv(). */ -#if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X) -# define _SOCKADDR_LEN -#endif - #if defined(HAS_SOCKET) && !defined(WIN32) /* WIN32 handles sockets via win32.h */ # include # if defined(USE_SOCKS) && defined(I_SOCKS) @@ -1221,6 +1226,7 @@ EXTERN_C char *crypt(const char *, const char *); # define SS_IVCHAN SS$_IVCHAN # define SS_NORMAL SS$_NORMAL # define SS_NOPRIV SS$_NOPRIV +# define SS_BUFFEROVF SS$_BUFFEROVF #else # define LIB_INVARG 0 # define RMS_DIR 0 @@ -1235,6 +1241,7 @@ EXTERN_C char *crypt(const char *, const char *); # define SS_IVCHAN 0 # define SS_NORMAL 0 # define SS_NOPRIV 0 +# define SS_BUFFEROVF 0 #endif #ifdef WIN32 @@ -1264,19 +1271,22 @@ EXTERN_C char *crypt(const char *, const char *); #define ERRSV GvSVn(PL_errgv) +/* contains inlined gv_add_by_type */ #define CLEAR_ERRSV() STMT_START { \ - if (!GvSV(PL_errgv)) { \ - sv_setpvs(GvSV(gv_add_by_type(PL_errgv, SVt_PV)), ""); \ - } else if (SvREADONLY(GvSV(PL_errgv))) { \ - SvREFCNT_dec(GvSV(PL_errgv)); \ - GvSV(PL_errgv) = newSVpvs(""); \ + SV ** const svp = &GvSV(PL_errgv); \ + if (!*svp) { \ + goto clresv_newemptypv; \ + } else if (SvREADONLY(*svp)) { \ + SvREFCNT_dec_NN(*svp); \ + clresv_newemptypv: \ + *svp = newSVpvs(""); \ } else { \ - SV *const errsv = GvSV(PL_errgv); \ + SV *const errsv = *svp; \ sv_setpvs(errsv, ""); \ + SvPOK_only(errsv); \ if (SvMAGICAL(errsv)) { \ mg_free(errsv); \ } \ - SvPOK_only(errsv); \ } \ } STMT_END @@ -1760,11 +1770,9 @@ typedef UVTYPE UV; #define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */ #ifdef USE_LONG_DOUBLE -# if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE -# define LONG_DOUBLE_EQUALS_DOUBLE -# endif -# if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)) -# undef USE_LONG_DOUBLE /* Ouch! */ +# if LONG_DOUBLESIZE == DOUBLESIZE +# define LONG_DOUBLE_EQUALS_DOUBLE +# undef USE_LONG_DOUBLE /* Ouch! */ # endif #endif @@ -1857,26 +1865,21 @@ typedef NVTYPE NV; # include #endif +#ifdef USING_MSVC6 +/* VC6 has broken NaN semantics: NaN == NaN returns true instead of false, + * and for example NaN < IV_MIN. */ +# define NAN_COMPARE_BROKEN +#endif +#if defined(__DECC) && defined(__osf__) +/* Also Tru64 cc has broken NaN comparisons. */ +# define NAN_COMPARE_BROKEN +#endif + #ifdef USE_LONG_DOUBLE # ifdef I_SUNMATH # include # endif -# if defined(USE_QUADMATH) && defined(I_QUADMATH) -# include -# endif -# ifdef FLT128_DIG -# define NV_DIG FLT128_DIG -# define NV_MANT_DIG FLT128_MANT_DIG -# define NV_MIN FLT128_MIN -# define NV_MAX FLT128_MAX -# define NV_MIN_EXP FLT128_MIN_EXP -# define NV_MAX_EXP FLT128_MAX_EXP -# define NV_EPSILON FLT128_EPSILON -# define NV_MIN_10_EXP FLT128_MIN_10_EXP -# define NV_MAX_10_EXP FLT128_MAX_10_EXP -# define NV_INF HUGE_VALQ -# define NV_NAN nanq("0") -# elif defined(LDBL_DIG) +# if defined(LDBL_DIG) # define NV_DIG LDBL_DIG # ifdef LDBL_MANT_DIG # define NV_MANT_DIG LDBL_MANT_DIG @@ -1911,33 +1914,7 @@ typedef NVTYPE NV; # endif # endif # endif -# if defined(USE_QUADMATH) && defined(I_QUADMATH) -# define Perl_acos acosq -# define Perl_asin asinq -# define Perl_atan atanq -# define Perl_atan2 atan2q -# define Perl_ceil ceilq -# define Perl_cos cosq -# define Perl_cosh coshq -# define Perl_exp expq -/* no Perl_fabs, but there's PERL_ABS */ -# define Perl_floor floorq -# define Perl_fmod fmodq -# define Perl_log logq -# define Perl_log10 log10q -# define Perl_pow powq -# define Perl_sin sinq -# define Perl_sinh sinhq -# define Perl_sqrt sqrtq -# define Perl_tan tanq -# define Perl_tanh tanhq -# define Perl_modf(x,y) modfq(x,y) -# define Perl_frexp(x,y) frexpq(x,y) -# define Perl_ldexp(x, y) ldexpq(x,y) -# define Perl_isinf(x) isinfq(x) -# define Perl_isnan(x) isnanq(x) -# define Perl_isfinite(x) !(isnanq(x) || isinfq(x)) -# elif defined(HAS_SQRTL) +# if defined(HAS_SQRTL) # define Perl_acos acosl # define Perl_asin asinl # define Perl_atan atanl @@ -1999,13 +1976,51 @@ extern long double Perl_my_frexpl(long double x, int *e); # ifndef Perl_isinf # if defined(HAS_ISINFL) && !(defined(isinf) && defined(HAS_C99)) # define Perl_isinf(x) isinfl(x) -# elif defined(LDBL_MAX) +# elif defined(LDBL_MAX) && !defined(NAN_COMPARE_BROKEN) # define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX) # endif # endif # ifndef Perl_isfinite # define Perl_isfinite(x) Perl_isfinitel(x) # endif +#elif defined(USE_QUADMATH) && defined(I_QUADMATH) +# include +# define NV_DIG FLT128_DIG +# define NV_MANT_DIG FLT128_MANT_DIG +# define NV_MIN FLT128_MIN +# define NV_MAX FLT128_MAX +# define NV_MIN_EXP FLT128_MIN_EXP +# define NV_MAX_EXP FLT128_MAX_EXP +# define NV_EPSILON FLT128_EPSILON +# define NV_MIN_10_EXP FLT128_MIN_10_EXP +# define NV_MAX_10_EXP FLT128_MAX_10_EXP +# define NV_INF HUGE_VALQ +# define NV_NAN nanq("0") +# define Perl_acos acosq +# define Perl_asin asinq +# define Perl_atan atanq +# define Perl_atan2 atan2q +# define Perl_ceil ceilq +# define Perl_cos cosq +# define Perl_cosh coshq +# define Perl_exp expq +/* no Perl_fabs, but there's PERL_ABS */ +# define Perl_floor floorq +# define Perl_fmod fmodq +# define Perl_log logq +# define Perl_log10 log10q +# define Perl_pow powq +# define Perl_sin sinq +# define Perl_sinh sinhq +# define Perl_sqrt sqrtq +# define Perl_tan tanq +# define Perl_tanh tanhq +# define Perl_modf(x,y) modfq(x,y) +# define Perl_frexp(x,y) frexpq(x,y) +# define Perl_ldexp(x, y) ldexpq(x,y) +# define Perl_isinf(x) isinfq(x) +# define Perl_isnan(x) isnanq(x) +# define Perl_isfinite(x) !(isnanq(x) || isinfq(x)) #else # define NV_DIG DBL_DIG # ifdef DBL_MANT_DIG @@ -2074,7 +2089,7 @@ extern long double Perl_my_frexpl(long double x, int *e); # ifndef Perl_isinf # if defined(HAS_ISINF) # define Perl_isinf(x) isinf(x) -# elif defined(DBL_MAX) +# elif defined(DBL_MAX) && !defined(NAN_COMPARE_BROKEN) # define Perl_isinf(x) ((x) > DBL_MAX || (x) < -DBL_MAX) # endif # endif @@ -2584,6 +2599,7 @@ typedef MEM_SIZE STRLEN; typedef struct op OP; typedef struct cop COP; typedef struct unop UNOP; +typedef struct unop_aux UNOP_AUX; typedef struct binop BINOP; typedef struct listop LISTOP; typedef struct logop LOGOP; @@ -2592,6 +2608,7 @@ typedef struct svop SVOP; typedef struct padop PADOP; typedef struct pvop PVOP; typedef struct loop LOOP; +typedef struct methop METHOP; #ifdef PERL_CORE typedef struct opslab OPSLAB; @@ -2641,12 +2658,12 @@ 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, +/* a 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; +typedef struct padnamelist PADNAMELIST; +typedef struct padname PADNAME; /* enable PERL_NEW_COPY_ON_WRITE by default */ #if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW) @@ -2663,7 +2680,12 @@ typedef SV PADNAME; # define PERL_SAWAMPERSAND #endif +#if defined(PERL_DEBUG_READONLY_OPS) && !defined(USE_ITHREADS) +# error PERL_DEBUG_READONLY_OPS only works with ithreads +#endif + #include "handy.h" +#include "charclass_invlists.h" #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) # if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO) @@ -2884,6 +2906,23 @@ typedef SV PADNAME; # define PERL_FPU_POST_EXEC } #endif +/* In Tru64 the cc -ieee enables the IEEE math but disables traps. + * We need to reenable the "invalid" trap because otherwise generation + * of NaN values leaves the IEEE fp flags in bad state, leaving any further + * fp ops behaving strangely (Inf + 1 resulting in zero, for example). */ +#ifdef __osf__ +# include +# define PERL_SYS_FPU_INIT \ + STMT_START { \ + ieee_set_fp_control(IEEE_TRAP_ENABLE_INV); \ + signal(SIGFPE, SIG_IGN); \ + } STMT_END +#endif + +#ifndef PERL_SYS_FPU_INIT +# define PERL_SYS_FPU_INIT NOOP +#endif + #ifndef PERL_SYS_INIT3_BODY # define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp) #endif @@ -3375,6 +3414,9 @@ typedef pthread_key_t perl_key; #endif #define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p) +#define PNf UTF8f +#define PNfARG(pn) (int)1, (UV)PadnameLEN(pn), (void *)PadnamePV(pn) + #ifdef PERL_CORE /* not used; but needed for backward compatibility with XS code? - RMB */ # undef UVf @@ -3435,7 +3477,10 @@ typedef pthread_key_t perl_key; # define __attribute__warn_unused_result__ #endif -#if defined(DEBUGGING) && defined(I_ASSERT) +#ifdef I_ASSERT +# if !defined(DEBUGGING) && !defined(NDEBUG) +# define NDEBUG 1 +# endif # include #endif @@ -3466,6 +3511,40 @@ typedef pthread_key_t perl_key; /* placeholder */ #endif +/* STATIC_ASSERT_GLOBAL/STATIC_ASSERT_STMT are like assert(), but for compile + time invariants. That is, their argument must be a constant expression that + can be verified by the compiler. This expression can contain anything that's + known to the compiler, e.g. #define constants, enums, or sizeof (...). If + the expression evaluates to 0, compilation fails. + Because they generate no runtime code (i.e. their use is "free"), they're + always active, even under non-DEBUGGING builds. + STATIC_ASSERT_GLOBAL expands to a declaration and is suitable for use at + file scope (outside of any function). + STATIC_ASSERT_STMT expands to a statement and is suitable for use inside a + function. +*/ +#if (defined(static_assert) || (defined(__cplusplus) && __cplusplus >= 201103L)) && (!defined(__IBMC__) || __IBMC__ >= 1210) +/* static_assert is a macro defined in in C11 or a compiler + builtin in C++11. +*/ +/* IBM XL C V11 does not support _Static_assert, no matter what says */ +# define STATIC_ASSERT_GLOBAL(COND) static_assert(COND, #COND) +#else +/* We use a bit-field instead of an array because gcc accepts + 'typedef char x[n]' where n is not a compile-time constant. + We want to enforce constantness. +*/ +# define STATIC_ASSERT_2(COND, SUFFIX) \ + typedef struct { \ + unsigned int _static_assertion_failed_##SUFFIX : (COND) ? 1 : -1; \ + } _static_assertion_failed_##SUFFIX PERL_UNUSED_DECL +# define STATIC_ASSERT_1(COND, SUFFIX) STATIC_ASSERT_2(COND, SUFFIX) +# define STATIC_ASSERT_GLOBAL(COND) STATIC_ASSERT_1(COND, __LINE__) +#endif +/* We need this wrapper even in C11 because 'case X: static_assert(...);' is an + error (static_assert is a declaration, and only statements can have labels). +*/ +#define STATIC_ASSERT_STMT(COND) do { STATIC_ASSERT_GLOBAL(COND); } while (0) #ifndef __has_builtin # define __has_builtin(x) 0 /* not a clang style compiler */ @@ -3476,13 +3555,13 @@ typedef pthread_key_t perl_key; expression, which allows the compiler to generate better machine code. In a debug build, ASSUME(x) is a synonym for assert(x). ASSUME(0) means the control path is unreachable. In a for loop, ASSUME can be used to hint - that a loop will run atleast X times. ASSUME is based off MSVC's __assume + that a loop will run at least X times. ASSUME is based off MSVC's __assume intrinsic function, see its documents for more details. */ #ifndef DEBUGGING # if __has_builtin(__builtin_unreachable) \ - || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 5) /* 4.5 -> */ + || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4) /* 4.5 -> */ # define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable()) # elif defined(_MSC_VER) # define ASSUME(x) __assume(x) @@ -3976,6 +4055,7 @@ Gid_t getegid (void); # define DEBUG_Pv_TEST DEBUG_Pv_TEST_ # define PERL_DEB(a) a +# define PERL_DEB2(a,b) a # define PERL_DEBUG(a) if (PL_debug) a # define DEBUG_p(a) if (DEBUG_p_TEST) a # define DEBUG_s(a) if (DEBUG_s_TEST) a @@ -4058,6 +4138,7 @@ Gid_t getegid (void); # define DEBUG_Pv_TEST (0) # define PERL_DEB(a) +# define PERL_DEB2(a,b) b # define PERL_DEBUG(a) # define DEBUG_p(a) # define DEBUG_s(a) @@ -4100,11 +4181,11 @@ Gid_t getegid (void); /* Keep the old croak based assert for those who want it, and as a fallback if the platform is so heretically non-ANSI that it can't assert. */ -#define Perl_assert(what) PERL_DEB( \ +#define Perl_assert(what) PERL_DEB2( \ ((what) ? ((void) 0) : \ (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \ "\", line %d", STRINGIFY(what), __LINE__), \ - (void) 0))) + (void) 0)), ((void)0)) /* assert() gets defined if DEBUGGING (and I_ASSERT). * If no DEBUGGING, the has not been included. */ @@ -4189,14 +4270,6 @@ START_EXTERN_C END_EXTERN_C #endif -#ifdef WIN32 -# if !defined(NV_INF) && defined(HUGE_VAL) -# define NV_INF HUGE_VAL -# endif -/* For WIN32 the best NV_NAN is the __PL_nan_u trick, see below. - * There is no supported way of getting the NAN across all the crts. */ -#endif - /* If you are thinking of using HUGE_VAL for infinity, or using * functions to generate NV_INF (e.g. exp(1e9), log(-1.0)), * stop. Neither will work portably: HUGE_VAL can be just DBL_MAX, @@ -4256,9 +4329,11 @@ static const union { unsigned int __i; float __f; } __PL_inf_u = # endif # if !defined(NV_NAN) && defined(LDBL_QNAN) # define NV_NAN LDBL_QNAN +# define NV_QNAN LDBL_QNAN # endif # if !defined(NV_NAN) && defined(LDBL_SNAN) # define NV_NAN LDBL_SNAN +# define NV_SNAN LDBL_SNAN # endif #endif #if !defined(NV_NAN) && defined(DBL_NAN) @@ -4266,18 +4341,27 @@ static const union { unsigned int __i; float __f; } __PL_inf_u = #endif #if !defined(NV_NAN) && defined(DBL_QNAN) # define NV_NAN (NV)DBL_QNAN +# define NV_QNAN DBL_QNAN #endif #if !defined(NV_NAN) && defined(DBL_SNAN) # define NV_NAN (NV)DBL_SNAN +# define NV_SNAN DBL_SNAN #endif #if !defined(NV_NAN) && defined(NAN) # define NV_NAN (NV)NAN #endif #if !defined(NV_NAN) && defined(QNAN) # define NV_NAN (NV)QNAN +# define NV_QNAN QNAN #endif #if !defined(NV_NAN) && defined(SNAN) # define NV_NAN (NV)SNAN +# define NV_SNAN SNAN +#endif +#if !defined(NV_NAN) && defined(I_SUNMATH) +# define NV_NAN (NV)quiet_nan() +# define NV_QNAN (NV)quiet_nan() +# define NV_SNAN (NV)signaling_nan() #endif #if !defined(NV_NAN) # if INTSIZE == 4 @@ -4543,12 +4627,13 @@ EXTCONST char PL_warn_nl[] INIT("Unsuccessful %s on filename containing newline"); EXTCONST char PL_no_wrongref[] INIT("Can't use %s ref as %s ref"); -/* The core no longer needs these here. If you require the string constant, +/* The core no longer needs this here. If you require the string constant, please inline a copy into your own code. */ EXTCONST char PL_no_symref[] __attribute__deprecated__ INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); -EXTCONST char PL_no_symref_sv[] __attribute__deprecated__ - INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use"); +EXTCONST char PL_no_symref_sv[] + INIT("Can't use string (\"%" SVf32 "\"%s) as %s ref while \"strict refs\" in use"); + EXTCONST char PL_no_usym[] INIT("Can't use an undefined value as %s reference"); EXTCONST char PL_no_aelem[] @@ -4568,7 +4653,7 @@ EXTCONST char PL_no_dir_func[] EXTCONST char PL_no_func[] INIT("The %s function is unimplemented"); EXTCONST char PL_no_myglob[] - INIT("\"%s\" variable %s can't be in a package"); + INIT("\"%s\" %se %s can't be in a package"); EXTCONST char PL_no_localize_ref[] INIT("Can't localize through a reference"); EXTCONST char PL_memory_wrap[] @@ -5193,8 +5278,8 @@ typedef enum { #define HINT_FEATURE_MASK 0x1c000000 /* 3 bits for feature bundles */ - /* Note: Used for NATIVE_HINTS, currently - defined by vms/vmsish.h: + /* Note: Used for HINT_M_VMSISH_*, + currently defined by vms/vmsish.h: 0x40000000 0x80000000 */ @@ -5216,6 +5301,16 @@ typedef enum { (SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT) #endif +/* Used for debugvar magic */ +#define DBVARMG_SINGLE 0 +#define DBVARMG_TRACE 1 +#define DBVARMG_SIGNAL 2 +#define DBVARMG_COUNT 3 + +#define PL_DBsingle_iv (PL_DBcontrol[DBVARMG_SINGLE]) +#define PL_DBtrace_iv (PL_DBcontrol[DBVARMG_TRACE]) +#define PL_DBsignal_iv (PL_DBcontrol[DBVARMG_SIGNAL]) + /* Various states of the input record separator SV (rs) */ #define RsSNARF(sv) (! SvOK(sv)) #define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv))) @@ -5455,6 +5550,26 @@ END_EXTERN_C #undef PERLVARI #undef PERLVARIC +#if !defined(MULTIPLICITY) +/* 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; + +/* this is never instantiated, is it just used for sizeof(struct PerlHandShakeInterpreter) */ +struct PerlHandShakeInterpreter { +# include "intrpvar.h" +}; +# undef PERLVAR +# undef PERLVARA +# undef PERLVARI +# undef PERLVARIC +#endif + START_EXTERN_C /* dummy variables that hold pointers to both runops functions, thus forcing @@ -5465,14 +5580,7 @@ EXTCONST runops_proc_t PL_runops_std 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. */ -#ifdef PERL_GLOBAL_STRUCT_PRIVATE -# define EXT_MGVTBL EXTCONST MGVTBL -#else -# define EXT_MGVTBL EXT MGVTBL -#endif +#define EXT_MGVTBL EXTCONST MGVTBL #define PERL_MAGIC_READONLY_ACCEPTABLE 0x40 #define PERL_MAGIC_VALUE_MAGIC 0x80 @@ -5640,19 +5748,19 @@ typedef struct am_table_short AMTS; #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)) -#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE)) -#define PERLDB_NOOPT (PL_perldb && (PL_perldb & PERLDBf_NOOPT)) -#define PERLDB_INTER (PL_perldb && (PL_perldb & PERLDBf_INTER)) -#define PERLDB_SUBLINE (PL_perldb && (PL_perldb & PERLDBf_SUBLINE)) -#define PERLDB_SINGLE (PL_perldb && (PL_perldb & PERLDBf_SINGLE)) -#define PERLDB_SUB_NN (PL_perldb && (PL_perldb & (PERLDBf_NONAME))) -#define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO)) -#define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL)) -#define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON)) -#define PERLDB_SAVESRC (PL_perldb && (PL_perldb & PERLDBf_SAVESRC)) -#define PERLDB_SAVESRC_NOSUBS (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS)) -#define PERLDB_SAVESRC_INVALID (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID)) +#define PERLDB_SUB (PL_perldb & PERLDBf_SUB) +#define PERLDB_LINE (PL_perldb & PERLDBf_LINE) +#define PERLDB_NOOPT (PL_perldb & PERLDBf_NOOPT) +#define PERLDB_INTER (PL_perldb & PERLDBf_INTER) +#define PERLDB_SUBLINE (PL_perldb & PERLDBf_SUBLINE) +#define PERLDB_SINGLE (PL_perldb & PERLDBf_SINGLE) +#define PERLDB_SUB_NN (PL_perldb & PERLDBf_NONAME) +#define PERLDB_GOTO (PL_perldb & PERLDBf_GOTO) +#define PERLDB_NAMEEVAL (PL_perldb & PERLDBf_NAMEEVAL) +#define PERLDB_NAMEANON (PL_perldb & PERLDBf_NAMEANON) +#define PERLDB_SAVESRC (PL_perldb & PERLDBf_SAVESRC) +#define PERLDB_SAVESRC_NOSUBS (PL_perldb & PERLDBf_SAVESRC_NOSUBS) +#define PERLDB_SAVESRC_INVALID (PL_perldb & PERLDBf_SAVESRC_INVALID) #ifdef USE_LOCALE /* These locale things are all subject to change */ @@ -5690,6 +5798,45 @@ typedef struct am_table_short AMTS; # define IN_LC(category) \ (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category)) +# if defined (PERL_CORE) || defined (PERL_IN_XSUB_RE) + + /* This internal macro should be called from places that operate under + * locale rules. It there is a problem with the current locale that + * hasn't been raised yet, it will output a warning this time. Because + * this will so rarely be true, there is no point to optimize for + * time; instead it makes sense to minimize space used and do all the + * work in the rarely called function */ +# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE \ + STMT_START { \ + if (UNLIKELY(PL_warn_locale)) { \ + _warn_problematic_locale(); \ + } \ + } STMT_END + + + /* These two internal macros are called when a warning should be raised, + * and will do so if enabled. The first takes a single code point + * argument; the 2nd, is a pointer to the first byte of the UTF-8 encoded + * string, and an end position which it won't try to read past */ +# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(cp) \ + Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), \ + "Wide character (U+%"UVXf") in %s", (UV) cp, OP_DESC(PL_op)); + +# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \ + STMT_START { /* Check if to warn before doing the conversion work */\ + if (ckWARN(WARN_LOCALE)) { \ + UV cp = utf8_to_uvchr_buf((U8 *) s, (U8 *) send, NULL); \ + Perl_warner(aTHX_ packWARN(WARN_LOCALE), \ + "Wide character (U+%"UVXf") in %s", \ + (cp == 0) \ + ? UNICODE_REPLACEMENT \ + : (UV) cp, \ + OP_DESC(PL_op)); \ + } \ + } STMT_END + +# endif /* PERL_CORE or PERL_IN_XSUB_RE */ + #else /* No locale usage */ # define IN_LOCALE_RUNTIME 0 # define IN_SOME_LOCALE_FORM_RUNTIME 0 @@ -5704,6 +5851,10 @@ typedef struct am_table_short AMTS; # define IN_LC_COMPILETIME(category) 0 # define IN_LC_RUNTIME(category) 0 # define IN_LC(category) 0 + +# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE +# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(a) +# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(a,b) #endif #ifdef USE_LOCALE_NUMERIC @@ -6021,8 +6172,10 @@ typedef struct am_table_short AMTS; /* 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 \ + void * old_my_cxtp = PL_my_cxt_list[MY_CXT_INDEX]; \ + PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp; \ + Copy(old_my_cxtp, my_cxtp, 1, my_cxt_t); + /* This macro must be used to access members of the my_cxt_t structure. @@ -6118,7 +6271,7 @@ int flock(int fd, int op); int). value returned in pointed- to UV */ #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */ -#define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation */ +#define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation or infnan */ #define IS_NUMBER_NEG 0x08 /* leading minus sign */ #define IS_NUMBER_INFINITY 0x10 /* this is big */ #define IS_NUMBER_NAN 0x20 /* this is not */ @@ -6252,31 +6405,109 @@ extern void moncontrol(int); * passed straight through to _escape. */ -#define PERL_PV_ESCAPE_QUOTE 0x0001 +#define PERL_PV_ESCAPE_QUOTE 0x000001 #define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE -#define PERL_PV_PRETTY_ELLIPSES 0x0002 -#define PERL_PV_PRETTY_LTGT 0x0004 +#define PERL_PV_PRETTY_ELLIPSES 0x000002 +#define PERL_PV_PRETTY_LTGT 0x000004 +#define PERL_PV_PRETTY_EXACTSIZE 0x000008 -#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008 +#define PERL_PV_ESCAPE_UNI 0x000100 +#define PERL_PV_ESCAPE_UNI_DETECT 0x000200 +#define PERL_PV_ESCAPE_NONASCII 0x000400 +#define PERL_PV_ESCAPE_FIRSTCHAR 0x000800 -#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 -#define PERL_PV_ESCAPE_NOCLEAR 0x4000 -#define PERL_PV_ESCAPE_RE 0x8000 +#define PERL_PV_ESCAPE_ALL 0x001000 +#define PERL_PV_ESCAPE_NOBACKSLASH 0x002000 +#define PERL_PV_ESCAPE_NOCLEAR 0x004000 +#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR +#define PERL_PV_ESCAPE_RE 0x008000 -#define PERL_PV_ESCAPE_DWIM 0x10000 +#define PERL_PV_ESCAPE_DWIM 0x010000 -#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR /* 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|PERL_PV_ESCAPE_NONASCII +#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN || \ + DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN || \ + DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN +# define DOUBLE_LITTLE_ENDIAN +#endif + +#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN || \ + DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN || \ + DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN +# define DOUBLE_BIG_ENDIAN +#endif + +#if DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE || \ + DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE +# define DOUBLE_MIX_ENDIAN +#endif + +/* All the basic IEEE formats have the implicit bit, + * except for the 80-bit extended formats, which will undef this. */ +#define NV_IMPLICIT_BIT + +#ifdef LONG_DOUBLEKIND + +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN +# define LONGDOUBLE_LITTLE_ENDIAN +# endif + +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN +# define LONGDOUBLE_BIG_ENDIAN +# endif + +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN +# define LONGDOUBLE_X86_80_BIT +# ifdef USE_LONG_DOUBLE +# undef NV_IMPLICIT_BIT +# endif +# endif + +# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN || \ + LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN +# define LONGDOUBLE_DOUBLEDOUBLE +# endif + +#endif /* LONG_DOUBLEKIND */ + +#if NVSIZE == DOUBLESIZE +# ifdef DOUBLE_LITTLE_ENDIAN +# define NV_LITTLE_ENDIAN +# endif +# ifdef DOUBLE_BIG_ENDIAN +# define NV_BIG_ENDIAN +# endif +# ifdef DOUBLE_MIX_ENDIAN +# define NV_MIX_ENDIAN +# endif +#elif NVSIZE == LONG_DOUBLESIZE +# ifdef LONGDOUBLE_LITTLE_ENDIAN +# define NV_LITTLE_ENDIAN +# endif +# ifdef LONGDOUBLE_BIG_ENDIAN +# define NV_BIG_ENDIAN +# endif +#endif + +/* The implicit bit platforms include the implicit bit + * in the NV_MANT_DIG. The bit isn't really there, however, + * so the real count of mantissa bits is one less. */ +#ifdef NV_IMPLICIT_BIT +# define NV_MANT_REAL_DIG (NV_MANT_DIG - 1) +#else +# define NV_MANT_REAL_DIG (NV_MANT_DIG) +#endif + /* (KEEP THIS LAST IN perl.h!)