X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e1895adcbd5ea43def0c89e1b0bff0628af49687..35bcf7ffa2bfeab79ab7b4eb0d35f462775b54d2:/perl.h diff --git a/perl.h b/perl.h index e436e03..cbb6905 100644 --- a/perl.h +++ b/perl.h @@ -31,11 +31,11 @@ /* this is used for functions which take a depth trailing * argument under debugging */ #ifdef DEBUGGING -#define _pDEPTH ,U32 depth -#define _aDEPTH ,depth +# define _pDEPTH ,U32 depth +# define _aDEPTH ,depth #else -#define _pDEPTH -#define _aDEPTH +# define _pDEPTH +# define _aDEPTH #endif /* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined @@ -62,18 +62,6 @@ # endif #endif -#ifdef PERL_GLOBAL_STRUCT_PRIVATE -# ifndef PERL_GLOBAL_STRUCT -# define PERL_GLOBAL_STRUCT -# endif -#endif - -#ifdef PERL_GLOBAL_STRUCT -# ifndef MULTIPLICITY -# define MULTIPLICITY -# endif -#endif - #ifdef MULTIPLICITY # ifndef PERL_IMPLICIT_CONTEXT # define PERL_IMPLICIT_CONTEXT @@ -86,27 +74,6 @@ # undef _WIN32 #endif -#if defined(__SYMBIAN32__) || (defined(__VC32__) && defined(WINS)) -# ifndef SYMBIAN -# define SYMBIAN -# endif -#endif - -#ifdef __SYMBIAN32__ -# include "symbian/symbian_proto.h" -#endif - -/* 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(__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. */ -# define USE_HEAP_INSTEAD_OF_STACK -#endif - /* Use the reentrant APIs like localtime_r and getpwent_r */ /* Win32 has naturally threadsafe libraries, no need to use any _r variants. * XXX KEEP makedef.pl copy of this code in sync */ @@ -116,18 +83,40 @@ /* <--- here ends the logic shared by perl.h and makedef.pl */ -/* Microsoft Visual C++ 6.0 needs special treatment in numerous places */ -#if defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1200 && _MSC_VER < 1300 -# define USING_MSVC6 -#endif +/* +=for apidoc_section $directives +=for apidoc AmnUu|void|EXTERN_C +When not compiling using C++, expands to nothing. +Otherwise is used in a declaration of a function to indicate the function +should have external C linkage. This is required for things to work for just +about all functions with external linkage compiled into perl. +Often, you can use C> ... C> blocks +surrounding all your code that you need to have this linkage. + +Example usage: + + EXTERN_C int flock(int fd, int op); + +=for apidoc Amnu||START_EXTERN_C +When not compiling using C++, expands to nothing. +Otherwise begins a section of code in which every function will effectively +have C> applied to it, that is to have external C linkage. The +section is ended by a C>. + +=for apidoc Amnu||END_EXTERN_C +When not compiling using C++, expands to nothing. +Otherwise ends a section of code already begun by a C>. + +=cut +*/ #undef START_EXTERN_C #undef END_EXTERN_C #undef EXTERN_C #ifdef __cplusplus -# define START_EXTERN_C extern "C" { -# define END_EXTERN_C } # define EXTERN_C extern "C" +# define START_EXTERN_C EXTERN_C { +# define END_EXTERN_C } #else # define START_EXTERN_C # define END_EXTERN_C @@ -146,25 +135,16 @@ # endif #endif -#if defined(PERL_GLOBAL_STRUCT) && !defined(PERL_GET_VARS) -# ifdef PERL_GLOBAL_STRUCT_PRIVATE - EXTERN_C struct perl_vars* Perl_GetVarsPrivate(); -# define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */ -# else -# define PERL_GET_VARS() PL_VarsPtr -# endif -#endif - -/* this used to be off by default, now its on, see perlio.h */ -#define PERLIO_FUNCS_CONST +/* +=for apidoc_section $concurrency +=for apidoc AmU|void|dTHXa|PerlInterpreter * a +On threaded perls, set C to C; on unthreaded perls, do nothing -#define pVAR struct perl_vars* my_vars PERL_UNUSED_DECL +=for apidoc AmU|void|dTHXoa|PerlInterpreter * a +Now a synonym for C>. -#ifdef PERL_GLOBAL_STRUCT -# define dVAR pVAR = (struct perl_vars*)PERL_GET_VARS() -#else -# define dVAR dNOOP -#endif +=cut +*/ #ifdef PERL_IMPLICIT_CONTEXT # ifndef MULTIPLICITY @@ -174,16 +154,8 @@ # 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 -# define dTHXa(a) pTHX = (tTHX)a -# endif -# ifdef PERL_GLOBAL_STRUCT -# define dTHX dVAR; pTHX = PERL_GET_THX -# else -# define dTHX pTHX = PERL_GET_THX -# endif +# define dTHXa(a) pTHX = (tTHX)a +# define dTHX pTHX = PERL_GET_THX # define pTHX_ pTHX, # define aTHX_ aTHX, # define pTHX_1 2 @@ -216,16 +188,24 @@ * implementation of multiplicity using C++ objects. They have been left * here solely for the sake of XS code which has incorrectly * cargo-culted them. + * + * The only one Devel::PPPort handles is this; list it as deprecated + +=for apidoc_section $concurrency +=for apidoc AmD|void|CPERLscope|void x +Now a no-op. + +=cut */ -#define CPERLscope(x) x -#define CPERLarg void -#define CPERLarg_ -#define _CPERLarg -#define PERL_OBJECT_THIS -#define _PERL_OBJECT_THIS -#define PERL_OBJECT_THIS_ -#define CALL_FPTR(fptr) (*fptr) -#define MEMBER_TO_FPTR(name) name +# define CPERLscope(x) x +# define CPERLarg void +# define CPERLarg_ +# define _CPERLarg +# define PERL_OBJECT_THIS +# define _PERL_OBJECT_THIS +# define PERL_OBJECT_THIS_ +# define CALL_FPTR(fptr) (*fptr) +# define MEMBER_TO_FPTR(name) name #endif /* !PERL_CORE */ #define CALLRUNOPS PL_runops @@ -291,17 +271,138 @@ RX_ENGINE(rx)->qr_package(aTHX_ (rx)) #if defined(USE_ITHREADS) -#define CALLREGDUPE(prog,param) \ +# define CALLREGDUPE(prog,param) \ Perl_re_dup(aTHX_ (prog),(param)) -#define CALLREGDUPE_PVT(prog,param) \ +# define CALLREGDUPE_PVT(prog,param) \ (prog ? RX_ENGINE(prog)->dupe(aTHX_ (prog),(param)) \ : (REGEXP *)NULL) #endif +/* some compilers impersonate gcc */ +#if defined(__GNUC__) && !defined(__clang__) && !defined(__INTEL_COMPILER) +# define PERL_IS_GCC 1 +#endif +/* In case Configure was not used (we are using a "canned config" + * such as Win32, or a cross-compilation setup, for example) try going + * by the gcc major and minor versions. One useful URL is + * http://www.ohse.de/uwe/articles/gcc-attributes.html, + * but contrary to this information warn_unused_result seems + * not to be in gcc 3.3.5, at least. --jhi + * Also, when building extensions with an installed perl, this allows + * the user to upgrade gcc and get the right attributes, rather than + * relying on the list generated at Configure time. --AD + * Set these up now otherwise we get confused when some of the <*thread.h> + * includes below indirectly pull in (which needs to know if we + * have HASATTRIBUTE_FORMAT). + */ +#ifndef PERL_MICRO +# if defined __GNUC__ && !defined(__INTEL_COMPILER) +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */ +# define HASATTRIBUTE_DEPRECATED +# endif +# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */ +# define HASATTRIBUTE_FORMAT +# if defined __MINGW32__ +# define PRINTF_FORMAT_NULL_OK +# endif +# endif +# if __GNUC__ >= 3 /* 3.0 -> */ +# define HASATTRIBUTE_MALLOC +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */ +# define HASATTRIBUTE_NONNULL +# endif +# if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */ +# define HASATTRIBUTE_NORETURN +# endif +# if __GNUC__ >= 3 /* gcc 3.0 -> */ +# define HASATTRIBUTE_PURE +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ +# define HASATTRIBUTE_UNUSED +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus) +# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */ +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ +# define HASATTRIBUTE_WARN_UNUSED_RESULT +# endif + /* always_inline is buggy in gcc <= 4.6 and causes compilation errors */ +# if __GNUC__ == 4 && __GNUC_MINOR__ >= 7 || __GNUC__ > 4 /* 4.7 -> */ +# define HASATTRIBUTE_ALWAYS_INLINE +# endif +# endif +#endif /* #ifndef PERL_MICRO */ +#ifdef HASATTRIBUTE_DEPRECATED +# define __attribute__deprecated__ __attribute__((deprecated)) +#endif +#ifdef HASATTRIBUTE_FORMAT +# define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) +#endif +#ifdef HASATTRIBUTE_MALLOC +# define __attribute__malloc__ __attribute__((__malloc__)) +#endif +#ifdef HASATTRIBUTE_NONNULL +# define __attribute__nonnull__(a) __attribute__((nonnull(a))) +#endif +#ifdef HASATTRIBUTE_NORETURN +# define __attribute__noreturn__ __attribute__((noreturn)) +#endif +#ifdef HASATTRIBUTE_PURE +# define __attribute__pure__ __attribute__((pure)) +#endif +#ifdef HASATTRIBUTE_UNUSED +# define __attribute__unused__ __attribute__((unused)) +#endif +#ifdef HASATTRIBUTE_WARN_UNUSED_RESULT +# define __attribute__warn_unused_result__ __attribute__((warn_unused_result)) +#endif +#ifdef HASATTRIBUTE_ALWAYS_INLINE +/* always_inline is buggy in gcc <= 4.6 and causes compilation errors */ +# if !defined(PERL_IS_GCC) || (__GNUC__ == 4 && __GNUC_MINOR__ >= 7 || __GNUC__ > 4) +# define __attribute__always_inline__ __attribute__((always_inline)) +# endif +#endif + +/* If we haven't defined the attributes yet, define them to blank. */ +#ifndef __attribute__deprecated__ +# define __attribute__deprecated__ +#endif +#ifndef __attribute__format__ +# define __attribute__format__(x,y,z) +#endif +#ifndef __attribute__malloc__ +# define __attribute__malloc__ +#endif +#ifndef __attribute__nonnull__ +# define __attribute__nonnull__(a) +#endif +#ifndef __attribute__noreturn__ +# define __attribute__noreturn__ +#endif +#ifndef __attribute__pure__ +# define __attribute__pure__ +#endif +#ifndef __attribute__unused__ +# define __attribute__unused__ +#endif +#ifndef __attribute__warn_unused_result__ +# define __attribute__warn_unused_result__ +#endif +#ifndef __attribute__always_inline__ +# define __attribute__always_inline__ +#endif + +/* Some OS warn on NULL format to printf */ +#ifdef PRINTF_FORMAT_NULL_OK +# define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z) +#else +# define __attribute__format__null_ok__(x,y,z) +#endif /* * Because of backward compatibility reasons the PERL_UNUSED_DECL @@ -312,29 +413,53 @@ * marking unused variables (they need e.g. a #pragma) and therefore * cpp macros like PERL_UNUSED_DECL cannot work for this purpose, even * if it were PERL_UNUSED_DECL(x), which it cannot be (see above). - * - */ -#if defined(__SYMBIAN32__) && defined(__GNUC__) -# ifdef __cplusplus -# define PERL_UNUSED_DECL -# else -# define PERL_UNUSED_DECL __attribute__((unused)) -# endif -#endif +=for apidoc_section $directives +=for apidoc AmnU||PERL_UNUSED_DECL +Tells the compiler that the parameter in the function prototype just before it +is not necessarily expected to be used in the function. Not that many +compilers understand this, so this should only be used in cases where +C> can't conveniently be used. + +Example usage: + +=over + + Signal_t + Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL, + void *uap PERL_UNUSED_DECL, bool safe) + +=back + +=cut + */ #ifndef PERL_UNUSED_DECL -# if defined(HASATTRIBUTE_UNUSED) && (!defined(__cplusplus) || __GNUC__ >= 4) -# define PERL_UNUSED_DECL __attribute__unused__ -# else -# define PERL_UNUSED_DECL -# endif +# define PERL_UNUSED_DECL __attribute__unused__ #endif /* gcc -Wall: * for silencing unused variables that are actually used most of the time, * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs, * or variables/arguments that are used only in certain configurations. + +=for apidoc Ams||PERL_UNUSED_ARG|void x +This is used to suppress compiler warnings that a parameter to a function is +not used. This situation can arise, for example, when a parameter is needed +under some configuration conditions, but not others, so that C preprocessor +conditional compilation causes it be used just some times. + +=for apidoc Amns||PERL_UNUSED_CONTEXT +This is used to suppress compiler warnings that the thread context parameter to +a function is not used. This situation can arise, for example, when a +C preprocessor conditional compilation causes it be used just some times. + +=for apidoc Ams||PERL_UNUSED_VAR|void x +This is used to suppress compiler warnings that the variable I is not used. +This situation can arise, for example, when a C preprocessor conditional +compilation causes it be used just some times. + +=cut */ #ifndef PERL_UNUSED_ARG # define PERL_UNUSED_ARG(x) ((void)sizeof(x)) @@ -343,7 +468,7 @@ # define PERL_UNUSED_VAR(x) ((void)sizeof(x)) #endif -#if defined(USE_ITHREADS) || defined(PERL_GLOBAL_STRUCT) +#if defined(USE_ITHREADS) # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) #else # define PERL_UNUSED_CONTEXT @@ -362,31 +487,40 @@ # endif #endif -/* Use PERL_UNUSED_RESULT() to suppress the warnings about unused results - * of function calls, e.g. PERL_UNUSED_RESULT(foo(a, b)). - * - * The main reason for this is that the combination of gcc -Wunused-result - * (part of -Wall) and the __attribute__((warn_unused_result)) cannot - * be silenced with casting to void. This causes trouble when the system - * header files use the attribute. - * - * Use PERL_UNUSED_RESULT sparingly, though, since usually the warning - * is there for a good reason: you might lose success/failure information, - * or leak resources, or changes in resources. - * - * But sometimes you just want to ignore the return value, e.g. on - * codepaths soon ending up in abort, or in "best effort" attempts, - * or in situations where there is no good way to handle failures. - * - * Sometimes PERL_UNUSED_RESULT might not be the most natural way: - * another possibility is that you can capture the return value - * and use PERL_UNUSED_VAR on that. - * - * The __typeof__() is used instead of typeof() since typeof() is not - * available under strict C89, and because of compilers masquerading - * as gcc (clang and icc), we want exactly the gcc extension - * __typeof__ and nothing else. - */ +/* + +=for apidoc Am||PERL_UNUSED_RESULT|void x + +This macro indicates to discard the return value of the function call inside +it, I, + + PERL_UNUSED_RESULT(foo(a, b)) + +The main reason for this is that the combination of C +(part of C<-Wall>) and the C<__attribute__((warn_unused_result))> cannot +be silenced with casting to C. This causes trouble when the system +header files use the attribute. + +Use C sparingly, though, since usually the warning +is there for a good reason: you might lose success/failure information, +or leak resources, or changes in resources. + +But sometimes you just want to ignore the return value, I, on +codepaths soon ending up in abort, or in "best effort" attempts, +or in situations where there is no good way to handle failures. + +Sometimes C might not be the most natural way: +another possibility is that you can capture the return value +and use C> on that. + +=cut + +The __typeof__() is used instead of typeof() since typeof() is not +available under strict C89, and because of compilers masquerading +as gcc (clang and icc), we want exactly the gcc extension +__typeof__ and nothing else. + +*/ #ifndef PERL_UNUSED_RESULT # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT) # define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END @@ -395,6 +529,11 @@ # endif #endif +#if defined(_MSC_VER) && _MSC_VER < 1400 +/* XXX older MSVC versions have a smallish macro buffer */ +# define PERL_SMALL_MACRO_BUFFER +#endif + /* on gcc (and clang), specify that a warning should be temporarily * ignored; e.g. * @@ -448,6 +587,31 @@ #define CLANG_DIAG_IGNORE_STMT(x) CLANG_DIAG_IGNORE(x) NOOP #define CLANG_DIAG_RESTORE_STMT CLANG_DIAG_RESTORE NOOP +#if defined(_MSC_VER) && (_MSC_VER >= 1300) +# define MSVC_DIAG_IGNORE(x) __pragma(warning(push)) \ + __pragma(warning(disable : x)) +# define MSVC_DIAG_RESTORE __pragma(warning(pop)) +#else +# define MSVC_DIAG_IGNORE(x) +# define MSVC_DIAG_RESTORE +#endif +#define MSVC_DIAG_IGNORE_DECL(x) MSVC_DIAG_IGNORE(x) dNOOP +#define MSVC_DIAG_RESTORE_DECL MSVC_DIAG_RESTORE dNOOP +#define MSVC_DIAG_IGNORE_STMT(x) MSVC_DIAG_IGNORE(x) NOOP +#define MSVC_DIAG_RESTORE_STMT MSVC_DIAG_RESTORE NOOP + +/* +=for apidoc Amns||NOOP +Do nothing; typically used as a placeholder to replace something that used to +do something. + +=for apidoc Amns||dNOOP +Declare nothing; typically used as a placeholder to replace something that used +to declare something. Works on compilers that require declarations before any +code. + +=cut +*/ #define NOOP /*EMPTY*/(void)0 #define dNOOP struct Perl___notused_struct @@ -474,18 +638,34 @@ # define pTHX_12 12 #endif -#ifndef dVAR +/* +=for apidoc_section $concurrency +=for apidoc AmnU||dVAR +This is now a synonym for dNOOP: declare nothing + +=for apidoc_section $XS +=for apidoc Amns||dMY_CXT_SV +Now a placeholder that declares nothing + +=cut +*/ + +#ifndef PERL_CORE + /* Backwards compatibility macro for XS code. It used to be part of the + * PERL_GLOBAL_STRUCT(_PRIVATE) feature, which no longer exists */ # define dVAR dNOOP -#endif -/* these are only defined for compatibility; should not be used internally */ -#if !defined(pTHXo) && !defined(PERL_CORE) -# define pTHXo pTHX -# define pTHXo_ pTHX_ -# define aTHXo aTHX -# define aTHXo_ aTHX_ -# define dTHXo dTHX -# define dTHXoa(x) dTHXa(x) + /* these are only defined for compatibility; should not be used internally. + * */ +# define dMY_CXT_SV dNOOP +# ifndef pTHXo +# define pTHXo pTHX +# define pTHXo_ pTHX_ +# define aTHXo aTHX +# define aTHXo_ aTHX_ +# define dTHXo dTHX +# define dTHXoa(x) dTHXa(x) +# endif #endif #ifndef pTHXx @@ -500,17 +680,9 @@ * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...). * dTHXs is therefore needed for all functions using PerlIO_foo(). */ #ifdef PERL_IMPLICIT_SYS -# ifdef PERL_GLOBAL_STRUCT_PRIVATE -# define dTHXs dVAR; dTHX -# else # define dTHXs dTHX -# endif #else -# ifdef PERL_GLOBAL_STRUCT_PRIVATE -# define dTHXs dVAR -# else # define dTHXs dNOOP -# endif #endif #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) @@ -520,12 +692,46 @@ #endif /* - * STMT_START { statements; } STMT_END; - * can be used as a single statement, as in - * if (x) STMT_START { ... } STMT_END; else ... - * - * Trying to select a version that gives no warnings... - */ +=for apidoc_section $directives +=for apidoc AmnUu|void|STMT_START +=for apidoc_item ||STMT_END + +This allows a series of statements in a macro to be used as a single statement, +as in + + if (x) STMT_START { ... } STMT_END else ... + +Note that you can't return a value out of them, which limits their utility. +But see C>. + +=for apidoc AmnuU|bool|PERL_USE_GCC_BRACE_GROUPS + +This C pre-processor value, if defined, indicates that it is permissible to use +the GCC brace groups extension. This extension, of the form + + ({ statement ... }) + +turns the block consisting of I into an expression with a +value, unlike plain C language blocks. This can present optimization +possibilities, B you generally need to specify an alternative in case this +ability doesn't exist or has otherwise been forbidden. + +Example usage: + +=over + + #ifdef PERL_USE_GCC_BRACE_GROUPS + ... + #else + ... + #endif + +=back + +=cut + + Trying to select a version that gives no warnings... +*/ #if !(defined(STMT_START) && defined(STMT_END)) # ifdef PERL_USE_GCC_BRACE_GROUPS # define STMT_START (void)( /* gcc supports "({ STATEMENTS; })" */ @@ -540,11 +746,6 @@ # define BYTEORDER 0x1234 #endif -/* Overall memory policy? */ -#ifndef CONSERVATIVE -# define LIBERAL 1 -#endif - #if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90 #define ASCIIish #else @@ -610,16 +811,24 @@ # define TAINT_WARN_get 0 # define TAINT_WARN_set(s) NOOP #else + /* Set to tainted if we are running under tainting mode */ # define TAINT (PL_tainted = PL_tainting) -# define TAINT_NOT (PL_tainted = FALSE) -# define TAINT_IF(c) if (UNLIKELY(c)) { PL_tainted = PL_tainting; } + +# define TAINT_NOT (PL_tainted = FALSE) /* Untaint */ +# define TAINT_IF(c) if (UNLIKELY(c)) { TAINT; } /* Conditionally taint */ # define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); } -# define TAINT_PROPER(s) if (UNLIKELY(PL_tainting)) { taint_proper(NULL, s); } + /* croak or warn if tainting */ +# 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 TAINT_get (cBOOL(UNLIKELY(PL_tainted))) /* Is something tainted? */ +# define TAINTING_get (cBOOL(UNLIKELY(PL_tainting))) /* Is taint checking enabled? */ # define TAINTING_set(s) (PL_tainting = (s)) -# define TAINT_WARN_get (PL_taint_warn) +# define TAINT_WARN_get (PL_taint_warn) /* FALSE => tainting violations + are fatal + TRUE => they're just + warnings */ # define TAINT_WARN_set(s) (PL_taint_warn = (s)) #endif @@ -683,15 +892,9 @@ #include -/* 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 1uL -#endif +# ifdef I_WCHAR +# include +# endif # include @@ -719,10 +922,33 @@ # include #endif -#if !defined(NO_LOCALE) && defined(HAS_SETLOCALE) -# define USE_LOCALE +/* If not forbidden, we enable locale handling if either 1) the POSIX 2008 + * functions are available, or 2) just the setlocale() function. This logic is + * repeated in t/loc_tools.pl and makedef.pl; The three should be kept in + * sync. */ +#if ! defined(NO_LOCALE) + +# if ! defined(NO_POSIX_2008_LOCALE) \ + && defined(HAS_NEWLOCALE) \ + && defined(HAS_USELOCALE) \ + && defined(HAS_DUPLOCALE) \ + && defined(HAS_FREELOCALE) \ + && defined(LC_ALL_MASK) + + /* For simplicity, the code is written to assume that any platform advanced + * enough to have the Posix 2008 locale functions has LC_ALL. The final + * test above makes sure that assumption is valid */ + +# define HAS_POSIX_2008_LOCALE +# define USE_LOCALE +# elif defined(HAS_SETLOCALE) +# define USE_LOCALE +# endif +#endif + +#ifdef USE_LOCALE # define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this - capability */ + #define */ # if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \ && defined(HAS_STRXFRM) # define USE_LOCALE_COLLATE @@ -757,31 +983,28 @@ # if !defined(NO_LOCALE_TELEPHONE) && defined(LC_TELEPHONE) # define USE_LOCALE_TELEPHONE # endif -#endif /* !NO_LOCALE && HAS_SETLOCALE */ +# if !defined(NO_LOCALE_SYNTAX) && defined(LC_SYNTAX) +# define USE_LOCALE_SYNTAX +# endif +# if !defined(NO_LOCALE_TOD) && defined(LC_TOD) +# define USE_LOCALE_TOD +# endif /* XXX The next few defines are unfortunately duplicated in makedef.pl, and * changes here MUST also be made there */ -#ifdef USE_LOCALE /* These locale things are all subject to change */ -# if defined(HAS_NEWLOCALE) \ - && defined(LC_ALL_MASK) \ - && defined(HAS_FREELOCALE) \ - && defined(HAS_USELOCALE) \ - && ! defined(NO_POSIX_2008_LOCALE) - - /* For simplicity, the code is written to assume that any platform advanced - * enough to have the Posix 2008 locale functions has LC_ALL. The test - * above makes sure that assumption is valid */ - -# define HAS_POSIX_2008_LOCALE -# endif +# if ! defined(HAS_SETLOCALE) && defined(HAS_POSIX_2008_LOCALE) +# define USE_POSIX_2008_LOCALE +# ifndef USE_THREAD_SAFE_LOCALE +# define USE_THREAD_SAFE_LOCALE +# endif /* If compiled with * -DUSE_THREAD_SAFE_LOCALE, will do so even * on unthreaded builds */ -# if (defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE)) \ - && ( defined(HAS_POSIX_2008_LOCALE) \ - || (defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1400)) \ - && ! defined(NO_THREAD_SAFE_LOCALE) +# elif (defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE)) \ + && ( defined(HAS_POSIX_2008_LOCALE) \ + || (defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1400)) \ + && ! defined(NO_THREAD_SAFE_LOCALE) # ifndef USE_THREAD_SAFE_LOCALE # define USE_THREAD_SAFE_LOCALE # endif @@ -847,10 +1070,6 @@ extern char **myenviron; # include #endif -#ifdef __SYMBIAN32__ -# undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */ -#endif - #if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) EXTERN_C int syscall(int, ...); #endif @@ -859,9 +1078,33 @@ EXTERN_C int syscall(int, ...); EXTERN_C int usleep(unsigned int); #endif -/* macros for correct constant construction. These are in C99 +/* Macros for correct constant construction. These are in C99 * (so they will not be available in strict C89 mode), but they are nice, so - * let's define them if necessary. */ + * let's define them if necessary. +=for apidoc_section $integer +=for apidoc Am|I16|INT16_C|number +=for apidoc_item |I32|INT32_C|number +=for apidoc_item |I64|INT64_C|number + +Returns a token the C compiler recognizes for the constant C of the +corresponding integer type on the machine. + +If the machine does not have a 64-bit type, C is undefined. +Use C> to get the largest type available on the platform. + +=for apidoc Am|U16|UINT16_C|number +=for apidoc_item |U32|UINT32_C|number +=for apidoc_item |U64|UINT64_C|number + +Returns a token the C compiler recognizes for the constant C of the +corresponding unsigned integer type on the machine. + +If the machine does not have a 64-bit type, C is undefined. +Use C> to get the largest type available on the platform. + + +=cut +*/ #ifndef UINT16_C # if INTSIZE >= 2 # define UINT16_C(x) ((U16_TYPE)x##U) @@ -927,6 +1170,33 @@ EXTERN_C int usleep(unsigned int); # define UINT64_C(c) PeRl_UINT64_C(c) # endif +/* +=for apidoc_section $integer +=for apidoc Am||INTMAX_C|number +Returns a token the C compiler recognizes for the constant C of the +widest integer type on the machine. For example, if the machine has Cs, C would yield + + -1LL + +See also, for example, C>. + +Use L to declare variables of the maximum usable size on this platform. + +=for apidoc Am||UINTMAX_C|number +Returns a token the C compiler recognizes for the constant C of the +widest unsigned integer type on the machine. For example, if the machine has +Cs, C would yield + + 1UL + +See also, for example, C>. + +Use L to declare variables of the maximum usable size on this platform. + +=cut +*/ + # ifndef I_STDINT typedef I64TYPE PERL_INTMAX_T; typedef U64TYPE PERL_UINTMAX_T; @@ -1024,7 +1294,7 @@ EXTERN_C int usleep(unsigned int); #define PERL_USES_PL_PIDSTATUS #endif -#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(__SYMBIAN32__) +#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) #define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION #endif @@ -1069,9 +1339,7 @@ EXTERN_C int usleep(unsigned int); # define Ptrdiff_t SSize_t #endif -#ifndef __SYMBIAN32__ # include -#endif /* This comes after so we don't try to change the standard * library prototypes; we'll use our own in proto.h instead. */ @@ -1124,6 +1392,12 @@ EXTERN_C int usleep(unsigned int); #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") #define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL) +/* +=for apidoc Am|void|memzero|void * d|Size_t l +Set the C bytes starting at C<*d> to all zeroes. + +=cut +*/ #ifndef memzero # define memzero(d,l) memset(d,0,l) #endif @@ -1239,6 +1513,38 @@ EXTERN_C char *crypt(const char *, const char *); EXTERN_C char *crypt(const char *, const char *); #endif +/* +=for apidoc_section $errno + +=for apidoc m|void|SETERRNO|int errcode|int vmserrcode + +Set C, and on VMS set C. + +=for apidoc mn|void|dSAVEDERRNO + +Declare variables needed to save C and any operating system +specific error number. + +=for apidoc mn|void|dSAVE_ERRNO + +Declare variables needed to save C and any operating system +specific error number, and save them for optional later restoration +by C. + +=for apidoc mn|void|SAVE_ERRNO + +Save C and any operating system specific error number for +optional later restoration by C. Requires +C or C in scope. + +=for apidoc mn|void|RESTORE_ERRNO + +Restore C and any operating system specific error number that +was saved by C or C. + +=cut +*/ + #ifdef SETERRNO # undef SETERRNO /* SOCKS might have defined this */ #endif @@ -1310,6 +1616,29 @@ EXTERN_C char *crypt(const char *, const char *); # define RESTORE_ERRNO (errno = saved_errno) #endif +/* +=for apidoc_section $warning + +=for apidoc Amn|SV *|ERRSV + +Returns the SV for C<$@>, creating it if needed. + +=for apidoc Am|void|CLEAR_ERRSV + +Clear the contents of C<$@>, setting it to the empty string. + +This replaces any read-only SV with a fresh SV and removes any magic. + +=for apidoc Am|void|SANE_ERRSV + +Clean up ERRSV so we can safely set it. + +This replaces any read-only SV with a fresh writable copy and removes +any magic. + +=cut +*/ + #define ERRSV GvSVn(PL_errgv) /* contains inlined gv_add_by_type */ @@ -1330,6 +1659,23 @@ EXTERN_C char *crypt(const char *, const char *); } \ } STMT_END +/* contains inlined gv_add_by_type */ +#define SANE_ERRSV() STMT_START { \ + SV ** const svp = &GvSV(PL_errgv); \ + if (!*svp) { \ + *svp = newSVpvs(""); \ + } else if (SvREADONLY(*svp)) { \ + SV *dupsv = newSVsv(*svp); \ + SvREFCNT_dec_NN(*svp); \ + *svp = dupsv; \ + } else { \ + SV *const errsv = *svp; \ + if (SvMAGICAL(errsv)) { \ + mg_free(errsv); \ + } \ + } \ + } STMT_END + #ifdef PERL_CORE # define DEFSV (0 + GvSVn(PL_defgv)) @@ -1348,6 +1694,20 @@ EXTERN_C char *crypt(const char *, const char *); # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif +/* +=for apidoc_section $SV +=for apidoc Amn|SV *|DEFSV +Returns the SV associated with C<$_> + +=for apidoc Am|void|DEFSV_set|SV * sv +Associate C with C<$_> + +=for apidoc Amn|void|SAVE_DEFSV +Localize C<$_>. See L. + +=cut +*/ + #ifndef errno extern int errno; /* ANSI allows errno to be an lvalue expr. * For example in multithreaded environments @@ -1358,7 +1718,7 @@ EXTERN_C char *crypt(const char *, const char *); #define UNKNOWN_ERRNO_MSG "(unknown)" -#if VMS +#ifdef VMS #define Strerror(e) strerror((e), vaxc$errno) #else #define Strerror(e) strerror(e) @@ -1555,9 +1915,16 @@ EXTERN_C char *crypt(const char *, const char *); /* This used to be conditionally defined based on whether we had a sprintf() * that correctly returns the string length (as required by C89), but we no * longer need that. XS modules can (and do) use this name, so it must remain - * a part of the API that's visible to modules. But we no longer document it - * either (because using sprintf() rather than snprintf() is almost always - * a bad idea). */ + * a part of the API that's visible to modules. + +=for apidoc_section $string +=for apidoc ATmD|int|my_sprintf|NN char *buffer|NN const char *pat|... + +Do NOT use this due to the possibility of overflowing C. Instead use +my_snprintf() + +=cut +*/ #define my_sprintf sprintf /* @@ -1640,8 +2007,6 @@ EXTERN_C char *crypt(const char *, const char *); #ifdef HAS_STRLCAT # define my_strlcat strlcat -#else -# define my_strlcat Perl_my_strlcat #endif #if defined(PERL_CORE) || defined(PERL_EXT) @@ -1654,14 +2019,10 @@ EXTERN_C char *crypt(const char *, const char *); #ifdef HAS_STRLCPY # define my_strlcpy strlcpy -#else -# define my_strlcpy Perl_my_strlcpy #endif #ifdef HAS_STRNLEN # define my_strnlen strnlen -#else -# define my_strnlen Perl_my_strnlen #endif /* @@ -1675,13 +2036,13 @@ typedef UVTYPE UV; #if defined(USE_64_BIT_INT) && defined(HAS_QUAD) # if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX) -# define IV_MAX INT64_MAX -# define IV_MIN INT64_MIN -# define UV_MAX UINT64_MAX +# define IV_MAX ((IV)INT64_MAX) +# define IV_MIN ((IV)INT64_MIN) +# define UV_MAX ((UV)UINT64_MAX) # ifndef UINT64_MIN # define UINT64_MIN 0 # endif -# define UV_MIN UINT64_MIN +# define UV_MIN ((UV)UINT64_MIN) # else # define IV_MAX PERL_QUAD_MAX # define IV_MIN PERL_QUAD_MIN @@ -1692,17 +2053,17 @@ typedef UVTYPE UV; # define UV_IS_QUAD #else # if defined(INT32_MAX) && IVSIZE == 4 -# define IV_MAX INT32_MAX -# define IV_MIN INT32_MIN +# define IV_MAX ((IV)INT32_MAX) +# define IV_MIN ((IV)INT32_MIN) # ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ -# define UV_MAX UINT32_MAX +# define UV_MAX ((UV)UINT32_MAX) # else -# define UV_MAX 4294967295U +# define UV_MAX ((UV)4294967295U) # endif # ifndef UINT32_MIN # define UINT32_MIN 0 # endif -# define UV_MIN UINT32_MIN +# define UV_MIN ((UV)UINT32_MIN) # else # define IV_MAX PERL_LONG_MAX # define IV_MIN PERL_LONG_MIN @@ -1718,11 +2079,10 @@ typedef UVTYPE UV; # else # undef IV_IS_QUAD # undef UV_IS_QUAD -#if !defined(PERL_CORE) || defined(USING_MSVC6) +#if !defined(PERL_CORE) /* We think that removing this decade-old undef this will cause too much breakage on CPAN for too little gain. (See RT #119753) - However, we do need HAS_QUAD in the core for use by the drand48 code, - but not for Win32 VC6 because it has poor __int64 support. */ + However, we do need HAS_QUAD in the core for use by the drand48 code. */ # undef HAS_QUAD #endif # endif @@ -1747,6 +2107,8 @@ typedef UVTYPE UV; * For int conversions we do not need two casts if pointers are * the same size as IV and UV. Otherwise we need an explicit * cast (PTRV) to avoid compiler warnings. + * + * These are mentioned in perlguts */ #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) # define PTRV UV @@ -1766,6 +2128,14 @@ typedef UVTYPE UV; # define PTR2ul(p) INT2PTR(unsigned long,p) #endif +/* +=for apidoc_section Casting +=for apidoc Cyh|type|NUM2PTR|type|int value +You probably want to be using L> instead. + +=cut +*/ + #define NUM2PTR(any,d) (any)(PTRV)(d) #define PTR2IV(p) INT2PTR(IV,p) #define PTR2UV(p) INT2PTR(UV,p) @@ -1814,11 +2184,6 @@ 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 @@ -2205,7 +2570,7 @@ extern long double Perl_my_frexpl(long double x, int *e); #endif /* Win32: _fpclass(), _isnan(), _finite(). */ -#ifdef WIN32 +#ifdef _MSC_VER # ifndef Perl_isnan # define Perl_isnan(x) _isnan(x) # endif @@ -2218,8 +2583,8 @@ extern long double Perl_my_frexpl(long double x, int *e); # define Perl_fp_class_snan(x) (_fpclass(x) & _FPCLASS_SNAN) # define Perl_fp_class_qnan(x) (_fpclass(x) & _FPCLASS_QNAN) # define Perl_fp_class_nan(x) (_fpclass(x) & (_FPCLASS_SNAN|_FPCLASS_QNAN)) -# define Perl_fp_class_ninf(x) (_fpclass(x) & _FPCLASS_NINF)) -# define Perl_fp_class_pinf(x) (_fpclass(x) & _FPCLASS_PINF)) +# define Perl_fp_class_ninf(x) (_fpclass(x) & _FPCLASS_NINF) +# define Perl_fp_class_pinf(x) (_fpclass(x) & _FPCLASS_PINF) # define Perl_fp_class_inf(x) (_fpclass(x) & (_FPCLASS_NINF|_FPCLASS_PINF)) # define Perl_fp_class_nnorm(x) (_fpclass(x) & _FPCLASS_NN) # define Perl_fp_class_pnorm(x) (_fpclass(x) & _FPCLASS_PN) @@ -2263,10 +2628,6 @@ extern long double Perl_my_frexpl(long double x, int *e); (Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x)) #endif -#ifdef UNDER_CE -int isnan(double d); -#endif - #ifndef Perl_isnan # ifdef Perl_fp_class_nan # define Perl_isnan(x) Perl_fp_class_nan(x) @@ -2351,6 +2712,41 @@ int isnan(double d); #define my_atof2(a,b) my_atof3(a,b,0) /* +=for apidoc_section $numeric +=for apidoc AmT|NV|Perl_acos|NV x +=for apidoc_item |NV|Perl_asin|NV x +=for apidoc_item |NV|Perl_atan|NV x +=for apidoc_item |NV|Perl_atan2|NV x|NV y +=for apidoc_item |NV|Perl_ceil|NV x +=for apidoc_item |NV|Perl_cos|NV x +=for apidoc_item |NV|Perl_cosh|NV x +=for apidoc_item |NV|Perl_exp|NV x +=for apidoc_item |NV|Perl_floor|NV x +=for apidoc_item |NV|Perl_fmod|NV x|NV y +=for apidoc_item |NV|Perl_frexp|NV x|int *exp +=for apidoc_item |IV|Perl_isfinite|NV x +=for apidoc_item |IV|Perl_isinf|NV x +=for apidoc_item |IV|Perl_isnan|NV x +=for apidoc_item |NV|Perl_ldexp|NV x|int exp +=for apidoc_item |NV|Perl_log|NV x +=for apidoc_item |NV|Perl_log10|NV x +=for apidoc_item |NV|Perl_modf|NV x|NV *iptr +=for apidoc_item |NV|Perl_pow|NV x|NV y +=for apidoc_item |NV|Perl_sin|NV x +=for apidoc_item |NV|Perl_sinh|NV x +=for apidoc_item |NV|Perl_sqrt|NV x +=for apidoc_item |NV|Perl_tan|NV x +=for apidoc_item |NV|Perl_tanh|NV x + +These perform the corresponding mathematical operation on the operand(s), using +the libc function designed for the task that has just enough precision for an +NV on this platform. If no such function with sufficient precision exists, +the highest precision one available is used. + +=cut +*/ + +/* * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be * ambiguous. It may be equivalent to (signed char) or (unsigned char) * depending on local options. Until Configure detects this (or at least @@ -2387,6 +2783,43 @@ int isnan(double d); # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) #endif +/* +=for apidoc_section $integer + +=for apidoc AmnU||PERL_INT_MAX +=for apidoc_item ||PERL_INT_MIN +=for apidoc_item ||PERL_LONG_MAX +=for apidoc_item ||PERL_LONG_MIN +=for apidoc_item ||PERL_SHORT_MAX +=for apidoc_item ||PERL_SHORT_MIN +=for apidoc_item ||PERL_UCHAR_MAX +=for apidoc_item ||PERL_UCHAR_MIN +=for apidoc_item ||PERL_UINT_MAX +=for apidoc_item ||PERL_UINT_MIN +=for apidoc_item ||PERL_ULONG_MAX +=for apidoc_item ||PERL_ULONG_MIN +=for apidoc_item ||PERL_USHORT_MAX +=for apidoc_item ||PERL_USHORT_MIN +=for apidoc_item ||PERL_QUAD_MAX +=for apidoc_item ||PERL_QUAD_MIN +=for apidoc_item ||PERL_UQUAD_MAX +=for apidoc_item ||PERL_UQUAD_MIN + +These give the largest and smallest number representable in the current +platform in variables of the corresponding types. + +For signed types, the smallest representable number is the most negative +number, the one furthest away from zero. + +For C99 and later compilers, these correspond to things like C, which +are available to the C code. But these constants, furnished by Perl, +allow code compiled on earlier compilers to portably have access to the same +constants. + +=cut + +*/ + typedef MEM_SIZE STRLEN; typedef struct op OP; @@ -2429,6 +2862,7 @@ typedef struct gv GV; typedef struct io IO; typedef struct context PERL_CONTEXT; typedef struct block BLOCK; +typedef struct invlist INVLIST; typedef struct magic MAGIC; typedef struct xpv XPV; @@ -2601,8 +3035,6 @@ typedef struct padname PADNAME; # else # include "vos/vosish.h" # endif -#elif defined(__SYMBIAN32__) -# include "symbian/symbianish.h" #elif defined(__HAIKU__) # include "haiku/haikuish.h" #else @@ -2644,6 +3076,36 @@ typedef struct padname PADNAME; # define USE_ENVIRON_ARRAY #endif +#if defined(HAS_SIGACTION) && defined(SA_SIGINFO) + /* having sigaction(2) means that the OS supports both 1-arg and 3-arg + * signal handlers. But the perl core itself only fully supports 1-arg + * handlers, so don't enable for now. + * NB: POSIX::sigaction() supports both. + * + * # define PERL_USE_3ARG_SIGHANDLER + */ +#endif + +/* Siginfo_t: + * This is an alias for the OS's siginfo_t, except that where the OS + * doesn't support it, declare a dummy version instead. This allows us to + * have signal handler functions which always have a Siginfo_t parameter + * regardless of platform, (and which will just be passed a NULL value + * where the OS doesn't support HAS_SIGACTION). + */ + +#if defined(HAS_SIGACTION) && defined(SA_SIGINFO) + typedef siginfo_t Siginfo_t; +#else +#ifdef si_signo /* minix */ +#undef si_signo +#endif + typedef struct { + int si_signo; + } Siginfo_t; +#endif + + /* * initialise to avoid floating-point exceptions from overflow, etc */ @@ -2712,7 +3174,7 @@ typedef struct padname PADNAME; #endif /* -=head1 Miscellaneous Functions +=for apidoc_section $embedding =for apidoc Am|void|PERL_SYS_INIT|int *argc|char*** argv Provides system-specific tune up of the C runtime environment necessary to @@ -2761,61 +3223,6 @@ freeing any remaining Perl interpreters. # endif #endif -/* In case Configure was not used (we are using a "canned config" - * such as Win32, or a cross-compilation setup, for example) try going - * by the gcc major and minor versions. One useful URL is - * http://www.ohse.de/uwe/articles/gcc-attributes.html, - * but contrary to this information warn_unused_result seems - * not to be in gcc 3.3.5, at least. --jhi - * Also, when building extensions with an installed perl, this allows - * the user to upgrade gcc and get the right attributes, rather than - * relying on the list generated at Configure time. --AD - * Set these up now otherwise we get confused when some of the <*thread.h> - * includes below indirectly pull in (which needs to know if we - * have HASATTRIBUTE_FORMAT). - */ - -#ifndef PERL_MICRO -#if defined __GNUC__ && !defined(__INTEL_COMPILER) -# if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */ -# define HASATTRIBUTE_DEPRECATED -# endif -# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */ -# define HASATTRIBUTE_FORMAT -# if defined __MINGW32__ -# define PRINTF_FORMAT_NULL_OK -# endif -# endif -# if __GNUC__ >= 3 /* 3.0 -> */ -# define HASATTRIBUTE_MALLOC -# endif -# if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */ -# define HASATTRIBUTE_NONNULL -# endif -# if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */ -# define HASATTRIBUTE_NORETURN -# endif -# if __GNUC__ >= 3 /* gcc 3.0 -> */ -# define HASATTRIBUTE_PURE -# endif -# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ -# define HASATTRIBUTE_UNUSED -# endif -# if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus) -# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */ -# endif -# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ -# define HASATTRIBUTE_WARN_UNUSED_RESULT -# endif -#endif -#endif /* #ifndef PERL_MICRO */ - -/* USE_5005THREADS needs to be after unixish.h as includes - * which defines NSIG - which will stop inclusion of - * this results in many functions being undeclared which bothers C++ - * May make sense to have threads after "*ish.h" anyway - */ - /* clang Thread Safety Analysis/Annotations/Attributes * http://clang.llvm.org/docs/ThreadSafetyAnalysis.html * @@ -2826,8 +3233,6 @@ freeing any remaining Perl interpreters. */ #if defined(USE_ITHREADS) && defined(I_PTHREAD) && \ defined(__clang__) && \ - !defined(PERL_GLOBAL_STRUCT) && \ - !defined(PERL_GLOBAL_STRUCT_PRIVATE) && \ !defined(SWIG) && \ ((!defined(__apple_build_version__) && \ ((__clang_major__ == 3 && __clang_minor__ >= 6) || \ @@ -2935,6 +3340,15 @@ typedef pthread_mutex_t PERL_TSA_CAPABILITY("mutex") perl_mutex; typedef pthread_cond_t perl_cond; typedef pthread_key_t perl_key; # endif + +/* Many readers; single writer */ +typedef struct { + perl_mutex lock; + perl_cond wakeup; + Size_t readers_count; +} perl_RnW1_mutex_t; + + #endif /* USE_ITHREADS */ #ifdef PERL_TSA_ACTIVE @@ -3326,7 +3740,10 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) #define HEKfARG(p) ((void*)(p)) -/* Takes three arguments: is_utf8, length, str */ +/* Documented in perlguts + * + * %4p is a custom format + */ #ifndef UTF8f # define UTF8f "d%" UVuf "%4p" #endif @@ -3336,63 +3753,18 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) #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 */ +/* not used; but needed for backward compatibility with XS code? - RMB +=for apidoc AmnD|const char *|UVf + +Obsolete form of C, which you should convert to instead use + +=cut +*/ # undef UVf #elif !defined(UVf) # define UVf UVuf #endif -#ifdef HASATTRIBUTE_DEPRECATED -# define __attribute__deprecated__ __attribute__((deprecated)) -#endif -#ifdef HASATTRIBUTE_FORMAT -# define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) -#endif -#ifdef HASATTRIBUTE_MALLOC -# define __attribute__malloc__ __attribute__((__malloc__)) -#endif -#ifdef HASATTRIBUTE_NONNULL -# define __attribute__nonnull__(a) __attribute__((nonnull(a))) -#endif -#ifdef HASATTRIBUTE_NORETURN -# define __attribute__noreturn__ __attribute__((noreturn)) -#endif -#ifdef HASATTRIBUTE_PURE -# define __attribute__pure__ __attribute__((pure)) -#endif -#ifdef HASATTRIBUTE_UNUSED -# define __attribute__unused__ __attribute__((unused)) -#endif -#ifdef HASATTRIBUTE_WARN_UNUSED_RESULT -# define __attribute__warn_unused_result__ __attribute__((warn_unused_result)) -#endif - -/* If we haven't defined the attributes yet, define them to blank. */ -#ifndef __attribute__deprecated__ -# define __attribute__deprecated__ -#endif -#ifndef __attribute__format__ -# define __attribute__format__(x,y,z) -#endif -#ifndef __attribute__malloc__ -# define __attribute__malloc__ -#endif -#ifndef __attribute__nonnull__ -# define __attribute__nonnull__(a) -#endif -#ifndef __attribute__noreturn__ -# define __attribute__noreturn__ -#endif -#ifndef __attribute__pure__ -# define __attribute__pure__ -#endif -#ifndef __attribute__unused__ -# define __attribute__unused__ -#endif -#ifndef __attribute__warn_unused_result__ -# define __attribute__warn_unused_result__ -#endif - #if !defined(DEBUGGING) && !defined(NDEBUG) # define NDEBUG 1 #endif @@ -3407,20 +3779,30 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) # define NORETURN_FUNCTION_END NOT_REACHED; return 0 #endif -/* Some OS warn on NULL format to printf */ -#ifdef PRINTF_FORMAT_NULL_OK -# define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z) -#else -# define __attribute__format__null_ok__(x,y,z) -#endif - #ifdef HAS_BUILTIN_EXPECT # define EXPECT(expr,val) __builtin_expect(expr,val) #else # define EXPECT(expr,val) (expr) #endif + +/* +=for apidoc_section $directives + +=for apidoc Am||LIKELY|bool expr + +Returns the input unchanged, but at the same time it gives a branch prediction +hint to the compiler that this condition is likely to be true. + +=for apidoc Am||UNLIKELY|bool expr + +Returns the input unchanged, but at the same time it gives a branch prediction +hint to the compiler that this condition is likely to be false. + +=cut +*/ #define LIKELY(cond) EXPECT(cBOOL(cond),TRUE) #define UNLIKELY(cond) EXPECT(cBOOL(cond),FALSE) + #ifdef HAS_BUILTIN_CHOOSE_EXPR /* placeholder */ #endif @@ -3437,8 +3819,11 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) 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 +#if (! defined(__IBMC__) || __IBMC__ >= 1210) \ + && (( defined(static_assert) && ( defined(_ISOC11_SOURCE) \ + || (__STDC_VERSION__ - 0) >= 201101L)) \ + || (defined(__cplusplus) && __cplusplus >= 201103L)) +/* XXX static_assert is a macro defined in in C11 or a compiler builtin in C++11. But IBM XL C V11 does not support _Static_assert, no matter what says. */ @@ -3464,40 +3849,55 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) # define __has_builtin(x) 0 /* not a clang style compiler */ #endif -/* ASSUME is like assert(), but it has a benefit in a release build. It is a - hint to a compiler about a statement of fact in a function call free - 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 at least X times. ASSUME is based off MSVC's __assume - intrinsic function, see its documents for more details. +/* +=for apidoc Am||ASSUME|bool expr +C is like C, but it has a benefit in a release build. It is a +hint to a compiler about a statement of fact in a function call free +expression, which allows the compiler to generate better machine code. In a +debug build, C is a synonym for C. C means the +control path is unreachable. In a for loop, C can be used to hint that +a loop will run at least X times. C is based off MSVC's C<__assume> +intrinsic function, see its documents for more details. + +=cut */ -#ifndef DEBUGGING -# if __has_builtin(__builtin_unreachable) \ - || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4) /* 4.5 -> */ +#ifdef DEBUGGING +# define ASSUME(x) assert(x) +# if __has_builtin(__builtin_unreachable) +# define HAS_BUILTIN_UNREACHABLE +# elif (defined(__GNUC__) && ( __GNUC__ > 4 \ + || __GNUC__ == 4 && __GNUC_MINOR__ >= 5)) +# define HAS_BUILTIN_UNREACHABLE +# endif +#endif + +#if defined(__sun) || (defined(__hpux) && !defined(__GNUC__)) +# ifndef ASSUME +# define ASSUME(x) /* ASSUME() generates warnings on Solaris */ +# endif +# define NOT_REACHED +#elif defined(HAS_BUILTIN_UNREACHABLE) +# ifndef ASSUME # define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable()) -# elif defined(_MSC_VER) +# endif +# define NOT_REACHED \ + STMT_START { \ + ASSUME(!"UNREACHABLE"); __builtin_unreachable(); \ + } STMT_END +#else +# if defined(_MSC_VER) # define ASSUME(x) __assume(x) # elif defined(__ARMCC_VERSION) /* untested */ # define ASSUME(x) __promise(x) # else -/* a random compiler might define assert to its own special optimization token - so pass it through to C lib as a last resort */ + /* a random compiler might define assert to its own special optimization + * token so pass it through to C lib as a last resort */ # define ASSUME(x) assert(x) # endif -#else -# define ASSUME(x) assert(x) -#endif - -#if defined(__sun) /* ASSUME() generates warnings on Solaris */ -# define NOT_REACHED -#elif defined(DEBUGGING) && (__has_builtin(__builtin_unreachable) \ - || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4)) /* 4.5 -> */ -# define NOT_REACHED STMT_START { ASSUME(0); __builtin_unreachable(); } STMT_END -#else -# define NOT_REACHED ASSUME(0) +# define NOT_REACHED ASSUME(!"UNREACHABLE") #endif +#undef HAS_BUILTIN_UNREACHABLE /* Some unistd.h's give a prototype for pause() even though HAS_PAUSE ends up undefined. This causes the #define @@ -3573,7 +3973,7 @@ typedef I32 (*filter_t) (pTHX_ int, SV *, int); && idx >= AvFILLp(PL_parser->rsfp_filters)) #define PERL_FILTER_EXISTS(i) \ (PL_parser && PL_parser->rsfp_filters \ - && (i) <= av_tindex(PL_parser->rsfp_filters)) + && (Size_t) (i) < av_count(PL_parser->rsfp_filters)) #if defined(_AIX) && !defined(_AIX43) #if defined(USE_REENTRANT) || defined(_REENTRANT) || defined(_THREAD_SAFE) @@ -3593,7 +3993,7 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ #ifndef PERL_CALLCONV # ifdef __cplusplus -# define PERL_CALLCONV extern "C" +# define PERL_CALLCONV EXTERN_C # else # define PERL_CALLCONV # endif @@ -3608,13 +4008,22 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ #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 + +/* PERL_STATIC_INLINE_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 +#ifndef PERL_STATIC_FORCE_INLINE +# define PERL_STATIC_FORCE_INLINE PERL_STATIC_INLINE +#endif + +#ifndef PERL_STATIC_FORCE_INLINE_NO_RET +# define PERL_STATIC_FORCE_INLINE_NO_RET PERL_STATIC_INLINE +#endif + #if !defined(OS2) # include "iperlsys.h" #endif @@ -3640,13 +4049,13 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ /* macros to define bit-fields in structs. */ #ifndef PERL_BITFIELD8 -# define PERL_BITFIELD8 unsigned +# define PERL_BITFIELD8 U8 #endif #ifndef PERL_BITFIELD16 -# define PERL_BITFIELD16 unsigned +# define PERL_BITFIELD16 U16 #endif #ifndef PERL_BITFIELD32 -# define PERL_BITFIELD32 unsigned +# define PERL_BITFIELD32 U32 #endif #include "sv.h" @@ -3679,7 +4088,8 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ -#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) \ + || defined(PERL_EXT_RE_BUILD) /* These have to be predeclared, as they are used in proto.h which is #included * before their definitions in regcomp.h. */ @@ -3826,6 +4236,21 @@ my_swap16(const U16 x) { /* This may look like unnecessary jumping through hoops, but converting out of range floating point values to integers *is* undefined behaviour, and it is starting to bite. + +=for apidoc_section $casting +=for apidoc Am|I32|I_32|NV what +Cast an NV to I32 while avoiding undefined C behavior + +=for apidoc Am|U32|U_32|NV what +Cast an NV to U32 while avoiding undefined C behavior + +=for apidoc Am|IV|I_V|NV what +Cast an NV to IV while avoiding undefined C behavior + +=for apidoc Am|UV|U_V|NV what +Cast an NV to UV while avoiding undefined C behavior + +=cut */ #ifndef CAST_INLINE #define I_32(what) (cast_i32((NV)(what))) @@ -3851,6 +4276,25 @@ my_swap16(const U16 x) { #define U_I(what) ((unsigned int)U_32(what)) #define U_L(what) U_32(what) +/* +=for apidoc_section $integer +=for apidoc Amn|IV|IV_MAX +The largest signed integer that fits in an IV on this platform. + +=for apidoc Amn|IV|IV_MIN +The negative signed integer furthest away from 0 that fits in an IV on this +platform. + +=for apidoc Amn|UV|UV_MAX +The largest unsigned integer that fits in a UV on this platform. + +=for apidoc Amn|UV|UV_MIN +The smallest unsigned integer that fits in a UV on this platform. It should +equal zero. + +=cut +*/ + #ifdef HAS_SIGNBIT # ifndef Perl_signbit # define Perl_signbit signbit @@ -3871,7 +4315,7 @@ my_swap16(const U16 x) { #endif #ifndef __cplusplus -#if !(defined(WIN32) || defined(UNDER_CE) || defined(SYMBIAN)) +#if !defined(WIN32) Uid_t getuid (void); Uid_t geteuid (void); Gid_t getgid (void); @@ -3922,7 +4366,8 @@ Gid_t getegid (void); #define DEBUG_B_FLAG 0x02000000 /*33554432*/ #define DEBUG_L_FLAG 0x04000000 /*67108864*/ #define DEBUG_i_FLAG 0x08000000 /*134217728*/ -#define DEBUG_MASK 0x0FFFEFFF /* mask of all the standard flags */ +#define DEBUG_y_FLAG 0x10000000 /*268435456*/ +#define DEBUG_MASK 0x1FFFEFFF /* mask of all the standard flags */ #define DEBUG_DB_RECURSE_FLAG 0x40000000 #define DEBUG_TOP_FLAG 0x80000000 /* -D was given --> PL_debug |= FLAG */ @@ -3954,10 +4399,12 @@ Gid_t getegid (void); # define DEBUG_B_TEST_ UNLIKELY(PL_debug & DEBUG_B_FLAG) # define DEBUG_L_TEST_ UNLIKELY(PL_debug & DEBUG_L_FLAG) # define DEBUG_i_TEST_ UNLIKELY(PL_debug & DEBUG_i_FLAG) +# define DEBUG_y_TEST_ UNLIKELY(PL_debug & DEBUG_y_FLAG) # define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_) # define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_) # define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_) # define DEBUG_Lv_TEST_ (DEBUG_L_TEST_ && DEBUG_v_TEST_) +# define DEBUG_yv_TEST_ (DEBUG_y_TEST_ && DEBUG_v_TEST_) #ifdef DEBUGGING @@ -3988,10 +4435,12 @@ Gid_t getegid (void); # define DEBUG_B_TEST DEBUG_B_TEST_ # define DEBUG_L_TEST DEBUG_L_TEST_ # define DEBUG_i_TEST DEBUG_i_TEST_ +# define DEBUG_y_TEST DEBUG_y_TEST_ # define DEBUG_Xv_TEST DEBUG_Xv_TEST_ # define DEBUG_Uv_TEST DEBUG_Uv_TEST_ # define DEBUG_Pv_TEST DEBUG_Pv_TEST_ # define DEBUG_Lv_TEST DEBUG_Lv_TEST_ +# define DEBUG_yv_TEST DEBUG_yv_TEST_ # define PERL_DEB(a) a # define PERL_DEB2(a,b) a @@ -4025,10 +4474,11 @@ Gid_t getegid (void); # define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a) -# ifndef PERL_EXT_RE_BUILD -# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a) -# else +/* For re_comp.c, re_exec.c, assume -Dr has been specified */ +# ifdef PERL_EXT_RE_BUILD # define DEBUG_r(a) STMT_START {a;} STMT_END +# else +# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a) # endif /* PERL_EXT_RE_BUILD */ # define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a) @@ -4040,6 +4490,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_Lv(a) DEBUG__(DEBUG_Lv_TEST, a) +# define DEBUG_yv(a) DEBUG__(DEBUG_yv_TEST, a) # define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a) # define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a) @@ -4052,6 +4503,7 @@ Gid_t getegid (void); # define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a) # define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a) # define DEBUG_i(a) DEBUG__(DEBUG_i_TEST, a) +# define DEBUG_y(a) DEBUG__(DEBUG_y_TEST, a) #else /* ! DEBUGGING below */ @@ -4082,10 +4534,12 @@ Gid_t getegid (void); # define DEBUG_B_TEST (0) # define DEBUG_L_TEST (0) # define DEBUG_i_TEST (0) +# define DEBUG_y_TEST (0) # define DEBUG_Xv_TEST (0) # define DEBUG_Uv_TEST (0) # define DEBUG_Pv_TEST (0) # define DEBUG_Lv_TEST (0) +# define DEBUG_yv_TEST (0) # define PERL_DEB(a) # define PERL_DEB2(a,b) b @@ -4116,10 +4570,12 @@ Gid_t getegid (void); # define DEBUG_B(a) # define DEBUG_L(a) # define DEBUG_i(a) +# define DEBUG_y(a) # define DEBUG_Xv(a) # define DEBUG_Uv(a) # define DEBUG_Pv(a) # define DEBUG_Lv(a) +# define DEBUG_yv(a) #endif /* DEBUGGING */ @@ -4439,21 +4895,44 @@ EXTCONST char PL_no_dir_func[] EXTCONST char PL_no_func[] INIT("The %s function is unimplemented"); EXTCONST char PL_no_myglob[] - INIT("\"%s\" %se %s can't be in a package"); + INIT("\"%s\" %s %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[] INIT("panic: memory wrap"); - +EXTCONST char PL_extended_cp_format[] + INIT("Code point 0x%" UVXf " is not Unicode, requires a Perl extension," + " and so is not portable"); EXTCONST char PL_Yes[] INIT("1"); EXTCONST char PL_No[] INIT(""); EXTCONST char PL_Zero[] INIT("0"); + +/* +=for apidoc_section $numeric +=for apidoc AmTuU|const char *|PL_hexdigit|U8 value + +This array, indexed by an integer, converts that value into the character that +represents it. For example, if the input is 8, the return will be a string +whose first character is '8'. What is actually returned is a pointer into a +string. All you are interested in is the first character of that string. To +get uppercase letters (for the values 10..15), add 16 to the index. Hence, +C is C<'b'>, and C is C<'B'>. Adding 16 +to an index whose representation is '0'..'9' yields the same as not adding 16. +Indices outside the range 0..31 result in (bad) undedefined behavior. + +=cut +*/ EXTCONST char PL_hexdigit[] INIT("0123456789abcdef0123456789ABCDEF"); +EXTCONST STRLEN PL_WARN_ALL + INIT(0); +EXTCONST STRLEN PL_WARN_NONE + INIT(0); + /* This is constant on most architectures, a global on OS/2 */ #ifndef OS2 EXTCONST char PL_sh_path[] @@ -4515,12 +4994,47 @@ EXTCONST int PL_sig_num[]; * folds such as outside the range or to multiple characters. */ #ifdef DOINIT -#ifndef EBCDIC +# ifndef EBCDIC /* The EBCDIC fold table depends on the code page, and hence is found in - * utfebcdic.h */ + * ebcdic_tables.h */ + +EXTCONST unsigned char PL_fold[] = { + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', + 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', + 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', + 'x', 'y', 'z', 91, 92, 93, 94, 95, + 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', + 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', + 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', + 'X', 'Y', 'Z', 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, + 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, + 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, + 200, 201, 202, 203, 204, 205, 206, 207, + 208, 209, 210, 211, 212, 213, 214, 215, + 216, 217, 218, 219, 220, 221, 222, 223, + 224, 225, 226, 227, 228, 229, 230, 231, + 232, 233, 234, 235, 236, 237, 238, 239, + 240, 241, 242, 243, 244, 245, 246, 247, + 248, 249, 250, 251, 252, 253, 254, 255 +}; -EXTCONST unsigned char PL_fold[] = { +EXT unsigned char PL_fold_locale[] = { /* Unfortunately not EXTCONST. */ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, @@ -4548,12 +5062,13 @@ EXTCONST unsigned char PL_fold[] = { 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215, - 216, 217, 218, 219, 220, 221, 222, 223, + 216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255 }; + EXTCONST unsigned char PL_fold_latin1[] = { /* Full latin1 complement folding, except for three problematic code points: * Micro sign (181 = 0xB5) and y with diearesis (255 = 0xFF) have their @@ -4666,145 +5181,29 @@ EXTCONST unsigned char PL_mod_latin1_uc[] = { 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, -#if UNICODE_MAJOR_VERSION > 2 \ - || (UNICODE_MAJOR_VERSION == 2 && UNICODE_DOT_VERSION >= 1 \ - && UNICODE_DOT_DOT_VERSION >= 8) +# if UNICODE_MAJOR_VERSION > 2 \ + || (UNICODE_MAJOR_VERSION == 2 && UNICODE_DOT_VERSION >= 1 \ + && UNICODE_DOT_DOT_VERSION >= 8) 255 /*sharp s*/, -#else /* uc(sharp s) is 'sharp s' itself in early unicode */ +# else /* uc(sharp s) is 'sharp s' itself in early unicode */ 223, -#endif +# endif 224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32, 232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32, 240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247, 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, 255 }; -#endif /* !EBCDIC, but still in DOINIT */ +# endif /* !EBCDIC, but still in DOINIT */ #else /* ! DOINIT */ -# ifndef EBCDIC +# ifndef EBCDIC EXTCONST unsigned char PL_fold[]; EXTCONST unsigned char PL_fold_latin1[]; EXTCONST unsigned char PL_mod_latin1_uc[]; EXTCONST unsigned char PL_latin1_lc[]; +EXT unsigned char PL_fold_locale[]; /* Unfortunately not EXTCONST. */ # endif #endif -#ifndef PERL_GLOBAL_STRUCT /* or perlvars.h */ -#ifdef DOINIT -EXT unsigned char PL_fold_locale[] = { /* Unfortunately not EXTCONST. */ - 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 10, 11, 12, 13, 14, 15, - 16, 17, 18, 19, 20, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, - 48, 49, 50, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 60, 61, 62, 63, - 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', - 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', - 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', - 'x', 'y', 'z', 91, 92, 93, 94, 95, - 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', - 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', - 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', - 'X', 'Y', 'Z', 123, 124, 125, 126, 127, - 128, 129, 130, 131, 132, 133, 134, 135, - 136, 137, 138, 139, 140, 141, 142, 143, - 144, 145, 146, 147, 148, 149, 150, 151, - 152, 153, 154, 155, 156, 157, 158, 159, - 160, 161, 162, 163, 164, 165, 166, 167, - 168, 169, 170, 171, 172, 173, 174, 175, - 176, 177, 178, 179, 180, 181, 182, 183, - 184, 185, 186, 187, 188, 189, 190, 191, - 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 202, 203, 204, 205, 206, 207, - 208, 209, 210, 211, 212, 213, 214, 215, - 216, 217, 218, 219, 220, 221, 222, 223, - 224, 225, 226, 227, 228, 229, 230, 231, - 232, 233, 234, 235, 236, 237, 238, 239, - 240, 241, 242, 243, 244, 245, 246, 247, - 248, 249, 250, 251, 252, 253, 254, 255 -}; -#else -EXT unsigned char PL_fold_locale[]; /* Unfortunately not EXTCONST. */ -#endif -#endif /* !PERL_GLOBAL_STRUCT */ - -#ifdef DOINIT -#ifdef EBCDIC -EXTCONST unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */ - 1, 2, 84, 151, 154, 155, 156, 157, - 165, 246, 250, 3, 158, 7, 18, 29, - 40, 51, 62, 73, 85, 96, 107, 118, - 129, 140, 147, 148, 149, 150, 152, 153, - 255, 6, 8, 9, 10, 11, 12, 13, - 14, 15, 24, 25, 26, 27, 28, 226, - 29, 30, 31, 32, 33, 43, 44, 45, - 46, 47, 48, 49, 50, 76, 77, 78, - 79, 80, 81, 82, 83, 84, 85, 86, - 87, 94, 95, 234, 181, 233, 187, 190, - 180, 96, 97, 98, 99, 100, 101, 102, - 104, 112, 182, 174, 236, 232, 229, 103, - 228, 226, 114, 115, 116, 117, 118, 119, - 120, 121, 122, 235, 176, 230, 194, 162, - 130, 131, 132, 133, 134, 135, 136, 137, - 138, 139, 201, 205, 163, 217, 220, 224, - 5, 248, 227, 244, 242, 255, 241, 231, - 240, 253, 16, 197, 19, 20, 21, 187, - 23, 169, 210, 245, 237, 249, 247, 239, - 168, 252, 34, 196, 36, 37, 38, 39, - 41, 42, 251, 254, 238, 223, 221, 213, - 225, 177, 52, 53, 54, 55, 56, 57, - 58, 59, 60, 61, 63, 64, 65, 66, - 67, 68, 69, 70, 71, 72, 74, 75, - 205, 208, 186, 202, 200, 218, 198, 179, - 178, 214, 88, 89, 90, 91, 92, 93, - 217, 166, 170, 207, 199, 209, 206, 204, - 160, 212, 105, 106, 108, 109, 110, 111, - 203, 113, 216, 215, 192, 175, 193, 243, - 172, 161, 123, 124, 125, 126, 127, 128, - 222, 219, 211, 195, 188, 193, 185, 184, - 191, 183, 141, 142, 143, 144, 145, 146 -}; -#else /* ascii rather than ebcdic */ -EXTCONST unsigned char PL_freq[] = { /* letter frequencies for mixed English/C */ - 1, 2, 84, 151, 154, 155, 156, 157, - 165, 246, 250, 3, 158, 7, 18, 29, - 40, 51, 62, 73, 85, 96, 107, 118, - 129, 140, 147, 148, 149, 150, 152, 153, - 255, 182, 224, 205, 174, 176, 180, 217, - 233, 232, 236, 187, 235, 228, 234, 226, - 222, 219, 211, 195, 188, 193, 185, 184, - 191, 183, 201, 229, 181, 220, 194, 162, - 163, 208, 186, 202, 200, 218, 198, 179, - 178, 214, 166, 170, 207, 199, 209, 206, - 204, 160, 212, 216, 215, 192, 175, 173, - 243, 172, 161, 190, 203, 189, 164, 230, - 167, 248, 227, 244, 242, 255, 241, 231, - 240, 253, 169, 210, 245, 237, 249, 247, - 239, 168, 252, 251, 254, 238, 223, 221, - 213, 225, 177, 197, 171, 196, 159, 4, - 5, 6, 8, 9, 10, 11, 12, 13, - 14, 15, 16, 17, 19, 20, 21, 22, - 23, 24, 25, 26, 27, 28, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, - 41, 42, 43, 44, 45, 46, 47, 48, - 49, 50, 52, 53, 54, 55, 56, 57, - 58, 59, 60, 61, 63, 64, 65, 66, - 67, 68, 69, 70, 71, 72, 74, 75, - 76, 77, 78, 79, 80, 81, 82, 83, - 86, 87, 88, 89, 90, 91, 92, 93, - 94, 95, 97, 98, 99, 100, 101, 102, - 103, 104, 105, 106, 108, 109, 110, 111, - 112, 113, 114, 115, 116, 117, 119, 120, - 121, 122, 123, 124, 125, 126, 127, 128, - 130, 131, 132, 133, 134, 135, 136, 137, - 138, 139, 141, 142, 143, 144, 145, 146 -}; -#endif -#else -EXTCONST unsigned char PL_freq[]; -#endif - /* 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 */ @@ -4841,9 +5240,6 @@ EXTCONST char PL_bincompat_options[] = # ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP " DEBUG_LEAKING_SCALARS_FORK_DUMP" # endif -# ifdef FCRYPT - " FCRYPT" -# endif # ifdef HAS_TIMES " HAS_TIMES" # endif @@ -4865,12 +5261,6 @@ EXTCONST char PL_bincompat_options[] = # ifdef PERL_DEBUG_READONLY_OPS " PERL_DEBUG_READONLY_OPS" # endif -# ifdef PERL_GLOBAL_STRUCT - " PERL_GLOBAL_STRUCT" -# endif -# ifdef PERL_GLOBAL_STRUCT_PRIVATE - " PERL_GLOBAL_STRUCT_PRIVATE" -# endif # ifdef PERL_IMPLICIT_CONTEXT " PERL_IMPLICIT_CONTEXT" # endif @@ -4880,12 +5270,6 @@ EXTCONST char PL_bincompat_options[] = # ifdef PERL_MICRO " PERL_MICRO" # endif -# ifdef PERL_NEED_APPCTX - " PERL_NEED_APPCTX" -# endif -# ifdef PERL_NEED_TIMESBASE - " PERL_NEED_TIMESBASE" -# endif # ifdef PERL_POISON " PERL_POISON" # endif @@ -5079,7 +5463,7 @@ typedef enum { #define HINT_RE_FLAGS 0x02000000 /* re '/xism' pragma */ -#define HINT_FEATURE_MASK 0x1c000000 /* 3 bits for feature bundles */ +#define HINT_FEATURE_MASK 0x3c000000 /* 4 bits for feature bundles */ /* Note: Used for HINT_M_VMSISH_*, currently defined by vms/vmsish.h: @@ -5091,6 +5475,16 @@ typedef enum { #define HINT_SORT_STABLE 0x00000100 /* sort styles */ #define HINT_SORT_UNSTABLE 0x00000200 +#define HINT_ALL_STRICT HINT_STRICT_REFS \ + | HINT_STRICT_SUBS \ + | HINT_STRICT_VARS + +#ifdef USE_STRICT_BY_DEFAULT +#define HINTS_DEFAULT HINT_ALL_STRICT +#else +#define HINTS_DEFAULT 0 +#endif + /* flags for PL_sawampersand */ #define SAWAMPERSAND_LEFT 1 /* saw $` */ @@ -5226,34 +5620,6 @@ 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 -/* MULTIPLICITY is automatically defined when PERL_GLOBAL_STRUCT is defined, - hence it's safe and sane to nest this within #ifdef MULTIPLICITY */ - -struct perl_vars { -# include "perlvars.h" -}; - -EXTCONST U16 PL_global_struct_size - INIT(sizeof(struct perl_vars)); - -# ifdef PERL_CORE -# ifndef PERL_GLOBAL_STRUCT_PRIVATE -EXT struct perl_vars PL_Vars; -EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); -# undef PERL_GET_VARS -# define PERL_GET_VARS() PL_VarsPtr -# endif /* !PERL_GLOBAL_STRUCT_PRIVATE */ -# else /* PERL_CORE */ -# if !defined(__GNUC__) || !defined(WIN32) -EXT -# endif /* WIN32 */ -struct perl_vars *PL_VarsPtr; -# define PL_Vars (*((PL_VarsPtr) \ - ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX)))) -# endif /* PERL_CORE */ -# endif /* PERL_GLOBAL_STRUCT */ - /* Done with PERLVAR macros for now ... */ # undef PERLVAR # undef PERLVARA @@ -5326,13 +5692,11 @@ END_EXTERN_C define HAVE_INTERP_INTERN */ #include "embed.h" -#ifndef PERL_GLOBAL_STRUCT START_EXTERN_C # include "perlvars.h" END_EXTERN_C -#endif #undef PERLVAR #undef PERLVARA @@ -5374,8 +5738,14 @@ EXTCONST runops_proc_t PL_runops_dbg #define PERL_MAGIC_READONLY_ACCEPTABLE 0x40 #define PERL_MAGIC_VALUE_MAGIC 0x80 #define PERL_MAGIC_VTABLE_MASK 0x3F + +/* can this type of magic be attached to a readonly SV? */ #define PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(t) \ (PL_magic_data[(U8)(t)] & PERL_MAGIC_READONLY_ACCEPTABLE) + +/* Is this type of magic container magic (%ENV, $1 etc), + * or value magic (pos, taint etc)? + */ #define PERL_MAGIC_TYPE_IS_VALUE_MAGIC(t) \ (PL_magic_data[(U8)(t)] & PERL_MAGIC_VALUE_MAGIC) @@ -5449,7 +5819,7 @@ EXTCONST bool PL_valid_types_NV_set[]; #ifndef EBCDIC /* The tables below are adapted from - * http://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which requires this copyright + * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which requires this copyright * notice: Copyright (c) 2008-2009 Bjoern Hoehrmann @@ -5476,7 +5846,7 @@ SOFTWARE. # ifdef DOINIT # if 0 /* This is the original table given in - http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ */ + https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ */ static U8 utf8d_C9[] = { /* The first part of the table maps bytes to character classes that * to reduce the size of the transition table and create bitmasks. */ @@ -5584,18 +5954,19 @@ EXTCONST U8 PL_extended_utf8_dfa_tab[] = { * byte ones (as they are always legal) are to this state. */ -# define NUM_CLASSES 18 -# define N0 0 -# define N1 ((N0) + NUM_CLASSES) -# define N2 ((N1) + NUM_CLASSES) -# define N3 ((N2) + NUM_CLASSES) -# define N4 ((N3) + NUM_CLASSES) -# define N5 ((N4) + NUM_CLASSES) -# define N6 ((N5) + NUM_CLASSES) -# define N7 ((N6) + NUM_CLASSES) -# define N8 ((N7) + NUM_CLASSES) -# define N9 ((N8) + NUM_CLASSES) -# define N10 ((N9) + NUM_CLASSES) +# if defined(PERL_CORE) +# define NUM_CLASSES 18 +# define N0 0 +# define N1 ((N0) + NUM_CLASSES) +# define N2 ((N1) + NUM_CLASSES) +# define N3 ((N2) + NUM_CLASSES) +# define N4 ((N3) + NUM_CLASSES) +# define N5 ((N4) + NUM_CLASSES) +# define N6 ((N5) + NUM_CLASSES) +# define N7 ((N6) + NUM_CLASSES) +# define N8 ((N7) + NUM_CLASSES) +# define N9 ((N8) + NUM_CLASSES) +# define N10 ((N9) + NUM_CLASSES) /*Class: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 */ /*N0*/ 0, 1,N1,N2,N3,N4,N5, 1, 1, 1, 1, 1, 1,N6,N7,N8,N9,N10, @@ -5618,7 +5989,7 @@ EXTCONST U8 PL_extended_utf8_dfa_tab[] = { * that can be returned immediately. * * The "Implementation details" portion of - * http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ shows how + * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ shows how * the first portion of the table maps each possible byte into a character * class. And that the classes for those bytes which are start bytes have been * carefully chosen so they serve as well to be used as a shift value to mask @@ -5637,7 +6008,7 @@ EXTCONST U8 PL_extended_utf8_dfa_tab[] = { * drops out immediately for that. In the dfa, classes 3 and 4 are used to * distinguish EF vs the rest. Then special code is used to deal with ED, * that's executed only when the dfa drops out. The code points started by ED - * are half surrogates, and half hangul syllables. This means that 2048 of the + * are half surrogates, and half hangul syllables. This means that 2048 of * the hangul syllables (about 18%) take longer than all other non-problematic * code points to handle. * @@ -5705,7 +6076,6 @@ EXTCONST U8 PL_strict_utf8_dfa_tab[] = { * the other continuations transitions to N1 * N5 Start byte is F0. Continuation bytes 80-8F are illegal (overlong); * [9AB]F transition to N10; the other continuations to N2. - * the other continuations transition to N2 * N6 Start byte is F[123]. Continuation bytes [89AB]F transition * to N10; the other continuations to N2. * N7 Start byte is F4. Continuation bytes 90-BF are illegal @@ -5724,30 +6094,30 @@ EXTCONST U8 PL_strict_utf8_dfa_tab[] = { * byte ones (as they are always legal) are to this state. */ -# undef N0 -# undef N1 -# undef N2 -# undef N3 -# undef N4 -# undef N5 -# undef N6 -# undef N7 -# undef N8 -# undef N9 -# undef NUM_CLASSES -# define NUM_CLASSES 19 -# define N0 0 -# define N1 ((N0) + NUM_CLASSES) -# define N2 ((N1) + NUM_CLASSES) -# define N3 ((N2) + NUM_CLASSES) -# define N4 ((N3) + NUM_CLASSES) -# define N5 ((N4) + NUM_CLASSES) -# define N6 ((N5) + NUM_CLASSES) -# define N7 ((N6) + NUM_CLASSES) -# define N8 ((N7) + NUM_CLASSES) -# define N9 ((N8) + NUM_CLASSES) -# define N10 ((N9) + NUM_CLASSES) -# define N11 ((N10) + NUM_CLASSES) +# undef N0 +# undef N1 +# undef N2 +# undef N3 +# undef N4 +# undef N5 +# undef N6 +# undef N7 +# undef N8 +# undef N9 +# undef NUM_CLASSES +# define NUM_CLASSES 19 +# define N0 0 +# define N1 ((N0) + NUM_CLASSES) +# define N2 ((N1) + NUM_CLASSES) +# define N3 ((N2) + NUM_CLASSES) +# define N4 ((N3) + NUM_CLASSES) +# define N5 ((N4) + NUM_CLASSES) +# define N6 ((N5) + NUM_CLASSES) +# define N7 ((N6) + NUM_CLASSES) +# define N8 ((N7) + NUM_CLASSES) +# define N9 ((N8) + NUM_CLASSES) +# define N10 ((N9) + NUM_CLASSES) +# define N11 ((N10) + NUM_CLASSES) /*Class: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ /*N0*/ 0, 1, N1, N2, N4, N7, N6, N3, N5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, @@ -5768,7 +6138,7 @@ EXTCONST U8 PL_strict_utf8_dfa_tab[] = { /* And below is yet another version of the above tables that accepts only UTF-8 * as defined by Corregidum #9. Hence no surrogates nor non-Unicode, but * it allows non-characters. This is isomorphic to the original table - * in http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ + * in https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ * * The classes are * 00-7F 0 @@ -5827,24 +6197,24 @@ EXTCONST U8 PL_c9_utf8_dfa_tab[] = { * byte ones (as they are always legal) are to this state. */ -# undef N0 -# undef N1 -# undef N2 -# undef N3 -# undef N4 -# undef N5 -# undef N6 -# undef N7 -# undef NUM_CLASSES -# define NUM_CLASSES 12 -# define N0 0 -# define N1 ((N0) + NUM_CLASSES) -# define N2 ((N1) + NUM_CLASSES) -# define N3 ((N2) + NUM_CLASSES) -# define N4 ((N3) + NUM_CLASSES) -# define N5 ((N4) + NUM_CLASSES) -# define N6 ((N5) + NUM_CLASSES) -# define N7 ((N6) + NUM_CLASSES) +# undef N0 +# undef N1 +# undef N2 +# undef N3 +# undef N4 +# undef N5 +# undef N6 +# undef N7 +# undef NUM_CLASSES +# define NUM_CLASSES 12 +# define N0 0 +# define N1 ((N0) + NUM_CLASSES) +# define N2 ((N1) + NUM_CLASSES) +# define N3 ((N2) + NUM_CLASSES) +# define N4 ((N3) + NUM_CLASSES) +# define N5 ((N4) + NUM_CLASSES) +# define N6 ((N5) + NUM_CLASSES) +# define N7 ((N6) + NUM_CLASSES) /*Class: 0 1 2 3 4 5 6 7 8 9 10 11 */ /*N0*/ 0, 1, N1, N2, N5, N7, N3, N4, N6, 1, 1, 1, @@ -5858,6 +6228,7 @@ EXTCONST U8 PL_c9_utf8_dfa_tab[] = { /*N7*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, N2, 1, 1, }; +# endif /* defined(PERL_CORE) */ # else /* End of is DOINIT */ EXTCONST U8 PL_extended_utf8_dfa_tab[]; @@ -5867,22 +6238,6 @@ EXTCONST U8 PL_c9_utf8_dfa_tab[]; # endif #endif /* end of isn't EBCDIC */ -#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" END_EXTERN_C @@ -5987,11 +6342,19 @@ typedef struct am_table_short AMTS; # define KEYWORD_PLUGIN_MUTEX_LOCK MUTEX_LOCK(&PL_keyword_plugin_mutex) # define KEYWORD_PLUGIN_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_keyword_plugin_mutex) # define KEYWORD_PLUGIN_MUTEX_TERM MUTEX_DESTROY(&PL_keyword_plugin_mutex) +# define USER_PROP_MUTEX_INIT MUTEX_INIT(&PL_user_prop_mutex) +# define USER_PROP_MUTEX_LOCK MUTEX_LOCK(&PL_user_prop_mutex) +# define USER_PROP_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_user_prop_mutex) +# define USER_PROP_MUTEX_TERM MUTEX_DESTROY(&PL_user_prop_mutex) #else # define KEYWORD_PLUGIN_MUTEX_INIT NOOP # define KEYWORD_PLUGIN_MUTEX_LOCK NOOP # define KEYWORD_PLUGIN_MUTEX_UNLOCK NOOP # define KEYWORD_PLUGIN_MUTEX_TERM NOOP +# define USER_PROP_MUTEX_INIT NOOP +# define USER_PROP_MUTEX_LOCK NOOP +# define USER_PROP_MUTEX_UNLOCK NOOP +# define USER_PROP_MUTEX_TERM NOOP #endif #ifdef USE_LOCALE /* These locale things are all subject to change */ @@ -6009,6 +6372,27 @@ typedef struct am_table_short AMTS; # define IN_SOME_LOCALE_FORM_COMPILETIME \ cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL)) +/* +=for apidoc_section $locale + +=for apidoc Amn|bool|IN_LOCALE + +Evaluates to TRUE if the plain locale pragma without a parameter (S>) is in effect. + +=for apidoc Amn|bool|IN_LOCALE_COMPILETIME + +Evaluates to TRUE if, when compiling a perl program (including an C) if +the plain locale pragma without a parameter (S>) is in effect. + +=for apidoc Amn|bool|IN_LOCALE_RUNTIME + +Evaluates to TRUE if, when executing a perl program (including an C) if +the plain locale pragma without a parameter (S>) is in effect. + +=cut +*/ + # define IN_LOCALE \ (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) # define IN_SOME_LOCALE_FORM \ @@ -6035,7 +6419,7 @@ typedef struct am_table_short AMTS; # 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 + * locale rules. If 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 @@ -6099,89 +6483,135 @@ typedef struct am_table_short AMTS; #endif -/* Locale/thread synchronization macros. These aren't needed if using - * thread-safe locale operations, except if something is broken */ -#if defined(USE_LOCALE) \ - && defined(USE_ITHREADS) \ - && (! defined(USE_THREAD_SAFE_LOCALE) || defined(TS_W32_BROKEN_LOCALECONV)) +/* Locale/thread synchronization macros. */ +#if ! ( defined(USE_LOCALE) \ + && defined(USE_ITHREADS) \ + && ( ! defined(USE_THREAD_SAFE_LOCALE) \ + || ( defined(HAS_LOCALECONV) \ + && ( ! defined(HAS_LOCALECONV_L) \ + || defined(TS_W32_BROKEN_LOCALECONV))) \ + || ( defined(HAS_NL_LANGINFO) \ + && ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L)) \ + || (defined(HAS_MBLEN) && ! defined(HAS_MBRLEN)) \ + || (defined(HAS_MBTOWC) && ! defined(HAS_MBRTOWC)) \ + || (defined(HAS_WCTOMB) && ! defined(HAS_WCRTOMB)))) -/* We have a locale object holding the 'C' locale for Posix 2008 */ -# ifndef USE_POSIX_2008_LOCALE -# define _LOCALE_TERM_POSIX_2008 NOOP -# else -# define _LOCALE_TERM_POSIX_2008 \ - STMT_START { \ - if (PL_C_locale_obj) { \ - /* Make sure we aren't using the locale \ - * space we are about to free */ \ - uselocale(LC_GLOBAL_LOCALE); \ - freelocale(PL_C_locale_obj); \ - PL_C_locale_obj = (locale_t) NULL; \ - } \ - } STMT_END -# endif +/* The whole expression just above was complemented, so here we have no need + * for thread synchronization, most likely it would be that this isn't a + * threaded build. */ +# define LOCALE_INIT +# define LOCALE_TERM +# define LC_NUMERIC_LOCK(cond) NOOP +# define LC_NUMERIC_UNLOCK NOOP +# define LOCALECONV_LOCK NOOP +# define LOCALECONV_UNLOCK NOOP +# define LOCALE_READ_LOCK NOOP +# define LOCALE_READ_UNLOCK NOOP +# define MBLEN_LOCK NOOP +# define MBLEN_UNLOCK NOOP +# define MBTOWC_LOCK NOOP +# define MBTOWC_UNLOCK NOOP +# define NL_LANGINFO_LOCK NOOP +# define NL_LANGINFO_UNLOCK NOOP +# define SETLOCALE_LOCK NOOP +# define SETLOCALE_UNLOCK NOOP +# define WCTOMB_LOCK NOOP +# define WCTOMB_UNLOCK NOOP +#else -/* This is used as a generic lock for locale operations. For example this is - * used when calling nl_langinfo() so that another thread won't zap the - * contents of its buffer before it gets saved; and it's called when changing - * the locale of LC_MESSAGES. On some systems the latter can cause the - * nl_langinfo buffer to be zapped under a race condition. - * - * If combined with LC_NUMERIC_LOCK, calls to this and its corresponding unlock - * should be contained entirely within the locked portion of LC_NUMERIC. This - * mutex should be used only in very short sections of code, while - * LC_NUMERIC_LOCK may span more operations. By always following this - * convention, deadlock should be impossible. But if necessary, the two - * mutexes could be combined. - * - * Actually, the two macros just below with the '_V' suffixes are used in just - * a few places where there is a broken localeconv(), but otherwise things are - * thread safe, and hence don't need locking. Just below LOCALE_LOCK and - * LOCALE_UNLOCK are defined in terms of these for use everywhere else */ -# define LOCALE_LOCK_V \ + /* Here, we will need critical sections in locale handling, because one or + * more of the above conditions are true. This could be because the + * platform doesn't have thread-safe locales, or that at least one of the + * locale-dependent functions in the core isn't thread-safe. The latter + * case is generally because they return a pointer to a static buffer, which + * may be per-process instead of per-thread. There are supposedly + * re-entrant, safe versions for all of them Perl currently uses (which the + * #if above checks for), but most platforms don't have all the needed ones + * available, and the Posix standard doesn't require nl_langinfo_l() to be + * fully thread-safe, so a Configure probe was written. localeconv_l() is + * uncommon, and judging by bug reports on the web, some earlier library + * localeconv_l versions were broken, so perhaps a probe is in order for + * that, but it would be a pain to write. + * + * On non-thread-safe systems, some of the above functions are vulnerable to + * races should another thread get control and change the locale in the + * middle of their execution. + * + * We currently use a single mutex for all these cases. This solves both + * the problem of another thread changing the locale, and the buffer being + * overwritten (the code copies the results to a safe place before releasing + * the mutex). Ideally, for locale thread-safe platforms where the only + * issue is another thread clobbering the function's static buffer, there + * would be a separate mutex for each such buffer. Otherwise, things get + * locked that don't need to. But, it is not expected that any of these + * will be called frequently, and the locked interval should be short, and + * modern platforms will have reentrant versions (which don't lock) for + * almost all of them, so khw thinks a single mutex should suffice. */ +# define LOCALE_LOCK_ \ STMT_START { \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ "%s: %d: locking locale\n", __FILE__, __LINE__)); \ MUTEX_LOCK(&PL_locale_mutex); \ } STMT_END -# define LOCALE_UNLOCK_V \ +# define LOCALE_UNLOCK_ \ STMT_START { \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ "%s: %d: unlocking locale\n", __FILE__, __LINE__)); \ MUTEX_UNLOCK(&PL_locale_mutex); \ } STMT_END -/* On windows, we just need the mutex for LOCALE_LOCK */ -# ifdef TS_W32_BROKEN_LOCALECONV -# define LOCALE_LOCK NOOP -# define LOCALE_UNLOCK NOOP -# define LOCALE_INIT MUTEX_INIT(&PL_locale_mutex); -# define LOCALE_TERM MUTEX_DESTROY(&PL_locale_mutex) -# define LC_NUMERIC_LOCK(cond) -# define LC_NUMERIC_UNLOCK + /* We do define a different macro for each case; then if we want to have + * separate mutexes for some of them, the only changes needed are here. + * Define just the necessary macros. The compiler should then croak if the + * #ifdef's in the code are incorrect */ +# if defined(HAS_LOCALECONV) && ( ! defined(HAS_POSIX_2008_LOCALE) \ + || ! defined(HAS_LOCALECONV_L) \ + || defined(TS_W32_BROKEN_LOCALECONV)) +# define LOCALECONV_LOCK LOCALE_LOCK_ +# define LOCALECONV_UNLOCK LOCALE_UNLOCK_ +# endif +# if defined(HAS_NL_LANGINFO) && ( ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \ + || ! defined(HAS_POSIX_2008_LOCALE)) +# define NL_LANGINFO_LOCK LOCALE_LOCK_ +# define NL_LANGINFO_UNLOCK LOCALE_UNLOCK_ +# endif +# if defined(HAS_MBLEN) && ! defined(HAS_MBRLEN) +# define MBLEN_LOCK LOCALE_LOCK_ +# define MBLEN_UNLOCK LOCALE_UNLOCK_ +# endif +# if defined(HAS_MBTOWC) && ! defined(HAS_MBRTOWC) +# define MBTOWC_LOCK LOCALE_LOCK_ +# define MBTOWC_UNLOCK LOCALE_UNLOCK_ +# endif +# if defined(HAS_WCTOMB) && ! defined(HAS_WCRTOMB) +# define WCTOMB_LOCK LOCALE_LOCK_ +# define WCTOMB_UNLOCK LOCALE_UNLOCK_ +# endif +# if defined(USE_THREAD_SAFE_LOCALE) + /* On locale thread-safe systems, we don't need these workarounds */ +# define LOCALE_TERM_LC_NUMERIC_ NOOP +# define LOCALE_INIT_LC_NUMERIC_ NOOP +# define LC_NUMERIC_LOCK(cond) NOOP +# define LC_NUMERIC_UNLOCK NOOP +# define LOCALE_INIT_LC_NUMERIC_ NOOP +# define LOCALE_TERM_LC_NUMERIC_ NOOP + + /* There may be instance core where we this is invoked yet should do + * nothing. Rather than have #ifdef's around them, define it here */ +# define SETLOCALE_LOCK NOOP +# define SETLOCALE_UNLOCK NOOP # else -# define LOCALE_LOCK LOCALE_LOCK_V -# define LOCALE_UNLOCK LOCALE_UNLOCK_V - - /* We also need to lock LC_NUMERIC for non-windows (hence Posix 2008) - * systems */ -# define LOCALE_INIT STMT_START { \ - MUTEX_INIT(&PL_locale_mutex); \ - MUTEX_INIT(&PL_lc_numeric_mutex); \ - } STMT_END - -# define LOCALE_TERM STMT_START { \ - MUTEX_DESTROY(&PL_locale_mutex); \ - MUTEX_DESTROY(&PL_lc_numeric_mutex); \ - _LOCALE_TERM_POSIX_2008; \ - } STMT_END - - /* This mutex is used to create critical sections where we want the - * LC_NUMERIC locale to be locked into either the C (standard) locale, or - * the underlying locale, so that other threads interrupting this one don't - * change it to the wrong state before we've had a chance to complete our - * operation. It can stay locked over an entire printf operation, for - * example. And so is made distinct from the LOCALE_LOCK mutex. +# define SETLOCALE_LOCK LOCALE_LOCK_ +# define SETLOCALE_UNLOCK LOCALE_UNLOCK_ + + /* On platforms without per-thread locales, when another thread can switch + * our locale, we need another mutex to create critical sections where we + * want the LC_NUMERIC locale to be locked into either the C (standard) + * locale, or the underlying locale, so that other threads interrupting + * this one don't change it to the wrong state before we've had a chance to + * complete our operation. It can stay locked over an entire printf + * operation, for example. And so is made distinct from the LOCALE_LOCK + * mutex. * * This simulates kind of a general semaphore. The current thread will * lock the mutex if the per-thread variable is zero, and then increments @@ -6195,7 +6625,13 @@ typedef struct am_table_short AMTS; * * Clang improperly gives warnings for this, if not silenced: * https://clang.llvm.org/docs/ThreadSafetyAnalysis.html#conditional-locks - * */ + * + * If LC_NUMERIC_LOCK is combined with one of the LOCKs above, calls to + * that and its corresponding unlock should be contained entirely within + * the locked portion of LC_NUMERIC. Those mutexes should be used only in + * very short sections of code, while LC_NUMERIC_LOCK may span more + * operations. By always following this convention, deadlock should be + * impossible. But if necessary, the two mutexes could be combined. */ # define LC_NUMERIC_LOCK(cond_to_panic_if_already_locked) \ CLANG_DIAG_IGNORE(-Wthread-safety) \ STMT_START { \ @@ -6209,7 +6645,7 @@ typedef struct am_table_short AMTS; else { \ PL_lc_numeric_mutex_depth++; \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: avoided lc_numeric_lock; depth=%d\n", \ + "%s: %d: avoided lc_numeric_lock; new depth=%d\n", \ __FILE__, __LINE__, PL_lc_numeric_mutex_depth)); \ if (cond_to_panic_if_already_locked) { \ Perl_croak_nocontext("panic: %s: %d: Trying to change" \ @@ -6231,22 +6667,42 @@ typedef struct am_table_short AMTS; else { \ PL_lc_numeric_mutex_depth--; \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ - "%s: %d: avoided lc_numeric_unlock; depth=%d\n", \ + "%s: %d: avoided lc_numeric_unlock; new depth=%d\n",\ __FILE__, __LINE__, PL_lc_numeric_mutex_depth)); \ } \ } STMT_END \ CLANG_DIAG_RESTORE -# endif /* End of needs locking LC_NUMERIC */ -#else /* Below is no locale sync needed */ -# define LOCALE_INIT -# define LOCALE_LOCK -# define LOCALE_LOCK_V -# define LOCALE_UNLOCK -# define LOCALE_UNLOCK_V -# define LC_NUMERIC_LOCK(cond) -# define LC_NUMERIC_UNLOCK -# define LOCALE_TERM +# define LOCALE_INIT_LC_NUMERIC_ MUTEX_INIT(&PL_lc_numeric_mutex) +# define LOCALE_TERM_LC_NUMERIC_ MUTEX_DESTROY(&PL_lc_numeric_mutex) +# endif + +# ifdef USE_POSIX_2008_LOCALE + /* We have a locale object holding the 'C' locale for Posix 2008 */ +# define LOCALE_TERM_POSIX_2008_ \ + STMT_START { \ + if (PL_C_locale_obj) { \ + /* Make sure we aren't using the locale \ + * space we are about to free */ \ + uselocale(LC_GLOBAL_LOCALE); \ + freelocale(PL_C_locale_obj); \ + PL_C_locale_obj = (locale_t) NULL; \ + } \ + } STMT_END +# else +# define LOCALE_TERM_POSIX_2008_ NOOP +# endif + +# define LOCALE_INIT STMT_START { \ + MUTEX_INIT(&PL_locale_mutex); \ + LOCALE_INIT_LC_NUMERIC_; \ + } STMT_END + +# define LOCALE_TERM STMT_START { \ + MUTEX_DESTROY(&PL_locale_mutex); \ + LOCALE_TERM_LC_NUMERIC_; \ + LOCALE_TERM_POSIX_2008_; \ + } STMT_END #endif #ifdef USE_LOCALE_NUMERIC @@ -6257,7 +6713,7 @@ typedef struct am_table_short AMTS; * operations used by Perl, namely the decimal point, and even the thousands * separator.) -=head1 Locale-related functions and macros +=for apidoc_section $locale =for apidoc Amn|void|DECLARATION_FOR_LC_NUMERIC_MANIPULATION @@ -6269,7 +6725,7 @@ any executable statements. =for apidoc Am|void|STORE_LC_NUMERIC_FORCE_TO_UNDERLYING -This is used by XS code that that is C locale-aware to force the +This is used by XS code that is C locale-aware to force the locale for category C to be what perl thinks is the current underlying locale. (The perl interpreter could be wrong about what the underlying locale actually is if some C or XS code has called the C library @@ -6330,7 +6786,15 @@ argument list, like this: On threaded perls not operating with thread-safe functionality, this macro uses a mutex to force a critical section. Therefore the matching RESTORE should be -close by, and guaranteed to be called. +close by, and guaranteed to be called; see L +for a more contained way to ensure that. + +=for apidoc Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric + +Same as L with in_lc_numeric provided +as the precalculated value of C. It is the caller's +responsibility to ensure that the status of C and C +cannot have changed since the precalculation. =for apidoc Am|void|RESTORE_LC_NUMERIC @@ -6351,6 +6815,36 @@ expression, but with an empty argument list, like this: ... } +=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED|block + +This macro invokes the supplied statement or block within the context +of a L .. L pair +if required, so eg: + + WITH_LC_NUMERIC_SET_TO_NEEDED( + SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis) + ); + +is equivalent to: + + { +#ifdef USE_LOCALE_NUMERIC + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + STORE_LC_NUMERIC_SET_TO_NEEDED(); +#endif + SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis); +#ifdef USE_LOCALE_NUMERIC + RESTORE_LC_NUMERIC(); +#endif + } + +=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric|block + +Same as L with in_lc_numeric provided +as the precalculated value of C. It is the caller's +responsibility to ensure that the status of C and C +cannot have changed since the precalculation. + =cut */ @@ -6378,12 +6872,13 @@ expression, but with an empty argument list, like this: # define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL -# define STORE_LC_NUMERIC_SET_TO_NEEDED() \ +# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in) \ STMT_START { \ + bool _in_lc_numeric = (in); \ LC_NUMERIC_LOCK( \ - (IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_UNDERLYING) \ - || _NOT_IN_NUMERIC_STANDARD); \ - if (IN_LC(LC_NUMERIC)) { \ + ( ( _in_lc_numeric && _NOT_IN_NUMERIC_UNDERLYING) \ + || (! _in_lc_numeric && _NOT_IN_NUMERIC_STANDARD))); \ + if (_in_lc_numeric) { \ if (_NOT_IN_NUMERIC_UNDERLYING) { \ Perl_set_numeric_underlying(aTHX); \ _restore_LC_NUMERIC_function \ @@ -6399,6 +6894,9 @@ expression, but with an empty argument list, like this: } \ } STMT_END +# define STORE_LC_NUMERIC_SET_TO_NEEDED() \ + STORE_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC)) + # define RESTORE_LC_NUMERIC() \ STMT_START { \ if (_restore_LC_NUMERIC_function) { \ @@ -6473,43 +6971,141 @@ expression, but with an empty argument list, like this: __FILE__, __LINE__, PL_numeric_standard)); \ } STMT_END +# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ + STMT_START { \ + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \ + STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric); \ + block; \ + RESTORE_LC_NUMERIC(); \ + } STMT_END; + +# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC), block) + #else /* !USE_LOCALE_NUMERIC */ # define SET_NUMERIC_STANDARD() # define SET_NUMERIC_UNDERLYING() # define IS_NUMERIC_RADIX(a, b) (0) -# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION +# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION dNOOP # define STORE_LC_NUMERIC_SET_STANDARD() # define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() +# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric) # define STORE_LC_NUMERIC_SET_TO_NEEDED() # define RESTORE_LC_NUMERIC() # define LOCK_LC_NUMERIC_STANDARD() # define UNLOCK_LC_NUMERIC_STANDARD() +# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ + STMT_START { block; } STMT_END +# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ + STMT_START { block; } STMT_END #endif /* !USE_LOCALE_NUMERIC */ +#ifdef USE_ITHREADS +# define ENV_LOCK PERL_WRITE_LOCK(&PL_env_mutex) +# define ENV_UNLOCK PERL_WRITE_UNLOCK(&PL_env_mutex) +# define ENV_READ_LOCK PERL_READ_LOCK(&PL_env_mutex) +# define ENV_READ_UNLOCK PERL_READ_UNLOCK(&PL_env_mutex) +# define ENV_INIT PERL_RW_MUTEX_INIT(&PL_env_mutex) +# define ENV_TERM PERL_RW_MUTEX_DESTROY(&PL_env_mutex) + + /* On platforms where the static buffer contained in getenv() is per-thread + * rather than process-wide, another thread executing a getenv() at the same + * time won't destroy ours before we have copied the result safely away and + * unlocked the mutex. On such platforms (which is most), we can have many + * readers of the environment at the same time. */ +# ifdef GETENV_PRESERVES_OTHER_THREAD +# define GETENV_LOCK ENV_READ_LOCK +# define GETENV_UNLOCK ENV_READ_UNLOCK +# else + /* If, on the other hand, another thread could zap our getenv() return, we + * need to keep them from executing until we are done */ +# define GETENV_LOCK ENV_LOCK +# define GETENV_UNLOCK ENV_UNLOCK +# endif +#else +# define ENV_LOCK NOOP +# define ENV_UNLOCK NOOP +# define ENV_READ_LOCK NOOP +# define ENV_READ_UNLOCK NOOP +# define ENV_INIT NOOP +# define ENV_TERM NOOP +# define GETENV_LOCK NOOP +# define GETENV_UNLOCK NOOP +#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 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). +*/ + +START_EXTERN_C + +# include "inline.h" + +END_EXTERN_C + +#endif + +/* Some critical sections need to lock both the locale and the environment. + * XXX khw intends to change this to lock both mutexes, but that brings up + * issues of potential deadlock, so should be done at the beginning of a + * development cycle. So for now, it just locks the environment. Note that + * many modern platforms are locale-thread-safe anyway, so locking the locale + * mutex is a no-op anyway */ +#define ENV_LOCALE_LOCK ENV_LOCK +#define ENV_LOCALE_UNLOCK ENV_UNLOCK + +/* And some critical sections care only that no one else is writing either the + * locale nor the environment. XXX Again this is for the future. This can be + * simulated with using COND_WAIT in thread.h */ +#define ENV_LOCALE_READ_LOCK ENV_LOCALE_LOCK +#define ENV_LOCALE_READ_UNLOCK ENV_LOCALE_UNLOCK + #define Atof my_atof -#ifdef USE_QUADMATH -# define Perl_strtod(s, e) strtoflt128(s, e) -#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE) -# if defined(__MINGW64_VERSION_MAJOR) && defined(HAS_STRTOLD) - /*********************************************** - We are unable to use strtold because of - https://sourceforge.net/p/mingw-w64/bugs/711/ - & - https://sourceforge.net/p/mingw-w64/bugs/725/ - - but __mingw_strtold is fine. - ***********************************************/ -# define Perl_strtod(s, e) __mingw_strtold(s, e) -# elif defined(HAS_STRTOLD) -# define Perl_strtod(s, e) strtold(s, e) -# elif defined(HAS_STRTOD) -# define Perl_strtod(s, e) (NV)strtod(s, e) /* Unavoidable loss. */ -# endif -#elif defined(HAS_STRTOD) -# define Perl_strtod(s, e) strtod(s, e) +/* + +=for apidoc_section $numeric + +=for apidoc AmTR|NV|Strtod|NN const char * const s|NULLOK char ** e + +This is a synonym for L. + +=for apidoc AmTR|NV|Strtol|NN const char * const s|NULLOK char ** e|int base + +Platform and configuration independent C. This expands to the +appropriate C-like function based on the platform and F +options>. For example it could expand to C or C instead of +C. + +=for apidoc AmTR|NV|Strtoul|NN const char * const s|NULLOK char ** e|int base + +Platform and configuration independent C. This expands to the +appropriate C-like function based on the platform and F +options>. For example it could expand to C or C instead of +C. + +=cut + +*/ + +#define Strtod my_strtod + +#if defined(HAS_STRTOD) \ + || defined(USE_QUADMATH) \ + || (defined(HAS_STRTOLD) && defined(HAS_LONG_DOUBLE) \ + && defined(USE_LONG_DOUBLE)) +# define Perl_strtod Strtod #endif #if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \ @@ -6572,6 +7168,14 @@ expression, but with an empty argument list, like this: # define Atoul(s) Strtoul(s, NULL, 10) #endif +#define grok_bin(s,lp,fp,rp) \ + grok_bin_oct_hex(s, lp, fp, rp, 1, _CC_BINDIGIT, 'b') +#define grok_oct(s,lp,fp,rp) \ + (*(fp) |= PERL_SCAN_DISALLOW_PREFIX, \ + grok_bin_oct_hex(s, lp, fp, rp, 3, _CC_OCTDIGIT, '\0')) +#define grok_hex(s,lp,fp,rp) \ + grok_bin_oct_hex(s, lp, fp, rp, 4, _CC_XDIGIT, 'x') + #ifndef PERL_SCRIPT_MODE #define PERL_SCRIPT_MODE "r" #endif @@ -6663,15 +7267,9 @@ expression, but with an empty argument list, like this: /* START_MY_CXT must appear in all extensions that define a my_cxt_t structure, * right after the definition (i.e. at file scope). The non-threads * case below uses it to declare the data as static. */ -# ifdef PERL_GLOBAL_STRUCT_PRIVATE -# define START_MY_CXT -# define MY_CXT_INDEX Perl_my_cxt_index(aTHX_ MY_CXT_KEY) -# define MY_CXT_INIT_ARG MY_CXT_KEY -# else # define START_MY_CXT static int my_cxt_index = -1; # define MY_CXT_INDEX my_cxt_index # define MY_CXT_INIT_ARG &my_cxt_index -# endif /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */ /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when @@ -6715,9 +7313,7 @@ expression, but with an empty argument list, like this: # define _aMY_CXT ,aMY_CXT #else /* PERL_IMPLICIT_CONTEXT */ - # define START_MY_CXT static my_cxt_t my_cxt; -# define dMY_CXT_SV dNOOP # define dMY_CXT dNOOP # define dMY_CXT_INTERP(my_perl) dNOOP # define MY_CXT_INIT NOOP @@ -6750,7 +7346,7 @@ expression, but with an empty argument list, like this: #endif #if defined(HAS_FLOCK) && !defined(HAS_FLOCK_PROTO) -int flock(int fd, int op); +EXTERN_C int flock(int fd, int op); #endif #ifndef O_RDONLY @@ -6804,19 +7400,50 @@ int flock(int fd, int op); #define IS_NUMBER_NAN 0x20 /* this is not */ #define IS_NUMBER_TRAILING 0x40 /* number has trailing trash */ +/* +=for apidoc_section $numeric + +=for apidoc AmdR|bool|GROK_NUMERIC_RADIX|NN const char **sp|NN const char *send + +A synonym for L + +=cut +*/ #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) -/* Input flags: */ +/* Number scan flags. All are used for input, the ones used for output are so + * marked */ #define PERL_SCAN_ALLOW_UNDERSCORES 0x01 /* grok_??? accept _ in numbers */ #define PERL_SCAN_DISALLOW_PREFIX 0x02 /* grok_??? reject 0x in hex etc */ -#define PERL_SCAN_SILENT_ILLDIGIT 0x04 /* grok_??? not warn about illegal digits */ -#define PERL_SCAN_SILENT_NON_PORTABLE 0x08 /* grok_??? not warn about very large - numbers which are <= UV_MAX */ + +/* grok_??? input: ignored; output: found overflow */ +#define PERL_SCAN_GREATER_THAN_UV_MAX 0x04 + +/* grok_??? don't warn about illegal digits. To preserve total backcompat, + * this isn't set on output if one is found. Instead, see + * PERL_SCAN_NOTIFY_ILLDIGIT. */ +#define PERL_SCAN_SILENT_ILLDIGIT 0x08 + #define PERL_SCAN_TRAILING 0x10 /* grok_number_flags() allow trailing and set IS_NUMBER_TRAILING */ -/* Output flags: */ -#define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */ +/* These are considered experimental, so not exposed publicly */ +#if defined(PERL_CORE) || defined(PERL_EXT) +/* grok_??? don't warn about very large numbers which are <= UV_MAX; + * output: found such a number */ +# define PERL_SCAN_SILENT_NON_PORTABLE 0x20 + +/* If this is set on input, and no illegal digit is found, it will be cleared + * on output; otherwise unchanged */ +# define PERL_SCAN_NOTIFY_ILLDIGIT 0x40 + +/* Don't warn on overflow; output flag still set */ +# define PERL_SCAN_SILENT_OVERFLOW 0x80 + +/* Forbid a leading underscore, which the other one doesn't */ +# define PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES (0x100|PERL_SCAN_ALLOW_UNDERSCORES) +#endif + /* to let user control profiling */ #ifdef PERL_GPROF_CONTROL @@ -6826,12 +7453,8 @@ extern void moncontrol(int); #define PERL_GPROF_MONCONTROL(x) #endif -#ifdef UNDER_CE -#include "wince.h" -#endif - /* ISO 6429 NEL - C1 control NExt Line */ -/* See http://www.unicode.org/unicode/reports/tr13/ */ +/* See https://www.unicode.org/unicode/reports/tr13/ */ #define NEXT_LINE_CHAR NEXT_LINE_NATIVE #ifndef PIPESOCK_MODE @@ -6848,6 +7471,8 @@ extern void moncontrol(int); #define PERL_MAGIC_UTF8_CACHESIZE 2 +#ifdef PERL_CORE + #define PERL_UNICODE_STDIN_FLAG 0x0001 #define PERL_UNICODE_STDOUT_FLAG 0x0002 #define PERL_UNICODE_STDERR_FLAG 0x0004 @@ -6886,10 +7511,33 @@ extern void moncontrol(int); #define PERL_UNICODE_WIDESYSCALLS 'W' #define PERL_UNICODE_UTF8CACHEASSERT 'a' +#endif + +/* +=for apidoc_section $signals +=for apidoc Amn|U32|PERL_SIGNALS_UNSAFE_FLAG +If this bit in C is set, the system is uing the pre-Perl 5.8 +unsafe signals. See L and L. + +=cut +*/ #define PERL_SIGNALS_UNSAFE_FLAG 0x0001 -/* Use instead of abs() since abs() forces its argument to be an int, - * but also beware since this evaluates its argument twice, so no x++. */ +/* +=for apidoc_section $numeric + +=for apidoc Am|int|PERL_ABS|int x + +Typeless C or C, I. (The usage below indicates it is for +integers, but it works for any type.) Use instead of these, since the C +library ones force their argument to be what it is expecting, potentially +leading to disaster. But also beware that this evaluates its argument twice, +so no C. + +=cut +*/ + #define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) #if defined(__DECC) && defined(__osf__) @@ -6907,9 +7555,19 @@ extern void moncontrol(int); # define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0) #endif -/* check embedded \0 characters in pathnames passed to syscalls, - but allow one ending \0 */ -#define IS_SAFE_SYSCALL(p, len, what, op_name) (S_is_safe_syscall(aTHX_ (p), (len), (what), (op_name))) + +/* +=for apidoc_section $utility + +=for apidoc Am|bool|IS_SAFE_SYSCALL|NN const char *pv|STRLEN len|NN const char *what|NN const char *op_name + +Same as L. + +=cut + +Allows one ending \0 +*/ +#define IS_SAFE_SYSCALL(p, len, what, op_name) (Perl_is_safe_syscall(aTHX_ (p), (len), (what), (op_name))) #define IS_SAFE_PATHNAME(p, len, op_name) IS_SAFE_SYSCALL((p), (len), "pathname", (op_name)) @@ -7175,7 +7833,9 @@ START_EXTERN_C */ /* The quadmath literals are anon structs which -Wc++-compat doesn't like. */ +# ifndef USE_CPLUSPLUS GCC_DIAG_IGNORE_DECL(-Wc++-compat); +# endif # ifdef USE_QUADMATH /* Cannot use HUGE_VALQ for PL_inf because not a compile-time @@ -7245,7 +7905,9 @@ INFNAN_NV_U8_DECL PL_nan = { 0.0/0.0 }; /* keep last */ # endif # endif +# ifndef USE_CPLUSPLUS GCC_DIAG_RESTORE_DECL; +# endif #else