/* 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
#endif
/* See L<perlguts/"The Perl API"> for detailed notes on
- * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
+ * MULTIPLICITY and PERL_IMPLICIT_SYS */
/* XXX NOTE that from here --> to <-- the same logic is
* repeated in makedef.pl, so be certain to update
# endif
#endif
+/* PERL_IMPLICIT_CONTEXT is a legacy synonym for MULTIPLICITY */
#ifdef MULTIPLICITY
# ifndef PERL_IMPLICIT_CONTEXT
# define PERL_IMPLICIT_CONTEXT
# endif
#endif
+#if defined(PERL_IMPLICIT_CONTEXT) && !defined(MULTIPLICITY)
+# define MULTIPLICITY
+#endif
/* undef WIN32 when building on Cygwin (for libwin32) - gph */
#ifdef __CYGWIN__
/* 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 */
-#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32)
+#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(WIN32)
# define USE_REENTRANT_API
#endif
/* <--- here ends the logic shared by perl.h and makedef.pl */
/*
-=for apidoc_section Compiler directives
+=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
# 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<pTHX> to C<a>; on unthreaded perls, do nothing
-#ifdef PERL_IMPLICIT_CONTEXT
-# ifndef MULTIPLICITY
-# define MULTIPLICITY
-# endif
+=for apidoc AmU|void|dTHXoa|PerlInterpreter * a
+Now a synonym for C<L</dTHXa>>.
+
+=cut
+*/
+
+#ifdef MULTIPLICITY
# define tTHX PerlInterpreter*
# define pTHX tTHX my_perl PERL_UNUSED_DECL
# define aTHX my_perl
*
* The only one Devel::PPPort handles is this; list it as deprecated
-=for apidoc_section Concurrency
+=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
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
# define PERL_IS_GCC 1
#endif
+#define PERL_GCC_VERSION_GE(major,minor,patch) \
+ (((100000 * __GNUC__) + (1000 * __GNUC_MINOR__) + __GNUC_PATCHLEVEL__) \
+ >= ((100000 * (major)) + (1000 * (minor)) + (patch)))
+#define PERL_GCC_VERSION_GT(major,minor,patch) \
+ (((100000 * __GNUC__) + (1000 * __GNUC_MINOR__) + __GNUC_PATCHLEVEL__) \
+ > ((100000 * (major)) + (1000 * (minor)) + (patch)))
+#define PERL_GCC_VERSION_LE(major,minor,patch) \
+ (((100000 * __GNUC__) + (1000 * __GNUC_MINOR__) + __GNUC_PATCHLEVEL__) \
+ <= ((100000 * (major)) + (1000 * (minor)) + (patch)))
+#define PERL_GCC_VERSION_LT(major,minor,patch) \
+ (((100000 * __GNUC__) + (1000 * __GNUC_MINOR__) + __GNUC_PATCHLEVEL__) \
+ < ((100000 * (major)) + (1000 * (minor)) + (patch)))
+
/* 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
*/
#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
+# if defined __GNUC__ && !defined(__INTEL_COMPILER)
+# if PERL_GCC_VERSION_GE(3,1,0)
+# define HASATTRIBUTE_DEPRECATED
+# endif
+# if PERL_GCC_VERSION_GE(3,0,0) /* XXX Verify this version */
+# define HASATTRIBUTE_FORMAT
+# if defined __MINGW32__
+# define PRINTF_FORMAT_NULL_OK
+# endif
+# endif
+# if PERL_GCC_VERSION_GE(3,0,0)
+# define HASATTRIBUTE_MALLOC
+# endif
+# if PERL_GCC_VERSION_GE(3,3,0)
+# define HASATTRIBUTE_NONNULL
+# endif
+# if PERL_GCC_VERSION_GE(2,5,0)
+# define HASATTRIBUTE_NORETURN
+# endif
+# if PERL_GCC_VERSION_GE(3,0,0)
+# define HASATTRIBUTE_PURE
+# endif
+# if PERL_GCC_VERSION_GE(3,4,0)
+# 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 PERL_GCC_VERSION_GE(3,4,0)
+# define HASATTRIBUTE_WARN_UNUSED_RESULT
+# endif
+ /* always_inline is buggy in gcc <= 4.6 and causes compilation errors */
+# if PERL_GCC_VERSION_GE(4,7,0)
+# define HASATTRIBUTE_ALWAYS_INLINE
# 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
#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)
+# if !defined(PERL_IS_GCC) || PERL_GCC_VERSION_GE(4,7,0)
# define __attribute__always_inline__ __attribute__((always_inline))
# endif
#endif
* 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).
-=for apidoc_section Compiler directives
+=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
*/
#if defined(PERL_GCC_PEDANTIC) || \
(defined(__GNUC__) && defined(__cplusplus) && \
- ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 2))))
+ (PERL_GCC_VERSION_LT(4,2,0)))
# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
# endif
# endif
#endif
-#if defined(_MSC_VER)
-/* 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.
*
*
*/
-#if defined(__clang__) || defined(__clang) || \
- (defined( __GNUC__) && ((__GNUC__ * 100) + __GNUC_MINOR__) >= 406)
+#if defined(__clang__) || defined(__clang) || PERL_GCC_VERSION_GE(4,6,0)
# define GCC_DIAG_PRAGMA(x) _Pragma (#x)
/* clang has "clang diagnostic" pragmas, but also understands gcc. */
# define GCC_DIAG_IGNORE(x) _Pragma("GCC diagnostic push") \
#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)
+#if defined(_MSC_VER)
# define MSVC_DIAG_IGNORE(x) __pragma(warning(push)) \
__pragma(warning(disable : x))
# define MSVC_DIAG_RESTORE __pragma(warning(pop))
#ifndef pTHX
/* Don't bother defining tTHX ; using it outside
- * code guarded by PERL_IMPLICIT_CONTEXT is an error.
+ * code guarded by MULTIPLICITY is an error.
*/
# define pTHX void
# define pTHX_
# define aTHXa(a) NOOP
# define dTHXa(a) dNOOP
# define dTHX dNOOP
-# define pTHX_1 1
+# define pTHX_1 1
# define pTHX_2 2
# define pTHX_3 3
# define pTHX_4 4
#endif
/*
-=for apidoc_section Concurrency
+=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
*/
/* these are only defined for compatibility; should not be used internally.
* */
+# define dMY_CXT_SV dNOOP
# ifndef pTHXo
# define pTHXo pTHX
# define pTHXo_ pTHX_
#endif
/*
-=for apidoc_section Compiler directives
+=for apidoc_section $directives
=for apidoc AmnUu|void|STMT_START
=for apidoc_item ||STMT_END
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; })" */
-# define STMT_END )
-# else
# define STMT_START do
# define STMT_END while (0)
-# endif
#endif
#ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */
*/
/* define this once if either system, instead of cluttering up the src */
-#if defined(MSDOS) || defined(WIN32) || defined(NETWARE)
+#if defined(WIN32)
#define DOSISH 1
#endif
# include <locale.h>
#endif
-#ifdef I_XLOCALE
+#ifdef NEED_XLOCALE_H
# include <xlocale.h>
#endif
* on unthreaded builds */
# elif (defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE)) \
&& ( defined(HAS_POSIX_2008_LOCALE) \
- || (defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1400)) \
+ || (defined(WIN32) && defined(_MSC_VER))) \
&& ! defined(NO_THREAD_SAFE_LOCALE)
# ifndef USE_THREAD_SAFE_LOCALE
# define USE_THREAD_SAFE_LOCALE
/* Macros for correct constant construction. These are in C99 <stdint.h>
* (so they will not be available in strict C89 mode), but they are nice, so
* let's define them if necessary.
-=for apidoc_section Integer configuration values
+=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
# endif
/*
-=for apidoc_section Integer configuration values
+=for apidoc_section $integer
=for apidoc Am||INTMAX_C|number
Returns a token the C compiler recognizes for the constant C<number> of the
widest integer type on the machine. For example, if the machine has C<long
(((U64)(x) & UINT64_C(0xff00000000000000)) >> 56) ))
# endif
-/* The old value was hard coded at 1008. (4096-16) seems to be a bit faster,
- at least on FreeBSD. YMMV, so experiment. */
-#ifndef PERL_ARENA_SIZE
-#define PERL_ARENA_SIZE 4080
-#endif
-
/* Maximum level of recursion */
#ifndef PERL_SUB_DEPTH_WARN
#define PERL_SUB_DEPTH_WARN 100
#define PERL_USES_PL_PIDSTATUS
#endif
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP)
+#if !defined(OS2) && !defined(WIN32)
#define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
#endif
# define saferealloc Perl_realloc
# define safefree Perl_mfree
# define CHECK_MALLOC_TOO_LATE_FOR_(code) STMT_START { \
- if (!TAINTING_get && MallocCfg_ptr[MallocCfg_cfg_env_read]) \
- code; \
+ if (!TAINTING_get && MallocCfg_ptr[MallocCfg_cfg_env_read]) \
+ code; \
} STMT_END
# define CHECK_MALLOC_TOO_LATE_FOR(ch) \
- CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch))
+ CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch))
# define panic_write2(s) write(2, s, strlen(s))
# define CHECK_MALLOC_TAINT(newval) \
- CHECK_MALLOC_TOO_LATE_FOR_( \
- if (newval) { \
- PERL_UNUSED_RESULT(panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n"));\
- exit(1); })
+ CHECK_MALLOC_TOO_LATE_FOR_( \
+ if (newval) { \
+ PERL_UNUSED_RESULT(panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n"));\
+ exit(1); })
# define MALLOC_CHECK_TAINT(argc,argv,env) STMT_START { \
- if (doing_taint(argc,argv,env)) { \
- MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1; \
+ if (doing_taint(argc,argv,env)) { \
+ MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1; \
}} STMT_END;
#else /* MYMALLOC */
# define safemalloc safesysmalloc
#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<l> bytes starting at C<*d> to all zeroes.
+
+=cut
+*/
#ifndef memzero
# define memzero(d,l) memset(d,0,l)
#endif
# endif
# endif
# ifdef I_NETDB
-# ifdef NETWARE
-# include<stdio.h>
-# endif
# include <netdb.h>
# endif
# ifndef ENOTSOCK
#endif
/*
-=for apidoc_section Errno
+=for apidoc_section $errno
=for apidoc m|void|SETERRNO|int errcode|int vmserrcode
#ifdef VMS
# define SETERRNO(errcode,vmserrcode) \
- STMT_START { \
- set_errno(errcode); \
- set_vaxc_errno(vmserrcode); \
- } STMT_END
+ STMT_START { \
+ set_errno(errcode); \
+ set_vaxc_errno(vmserrcode); \
+ } STMT_END
# define dSAVEDERRNO int saved_errno; unsigned saved_vms_errno
# define dSAVE_ERRNO int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno
# define SAVE_ERRNO ( saved_errno = errno, saved_vms_errno = vaxc$errno )
#endif
/*
-=for apidoc_section Warning and Dieing
+=for apidoc_section $warning
=for apidoc Amn|SV *|ERRSV
if (!*svp) { \
*svp = newSVpvs(""); \
} else if (SvREADONLY(*svp)) { \
- SvREFCNT_dec_NN(*svp); \
- *svp = newSVpvs(""); \
+ SvREFCNT_dec_NN(*svp); \
+ *svp = newSVpvs(""); \
} else { \
- SV *const errsv = *svp; \
+ SV *const errsv = *svp; \
SvPVCLEAR(errsv); \
- SvPOK_only(errsv); \
- if (SvMAGICAL(errsv)) { \
- mg_free(errsv); \
- } \
+ SvPOK_only(errsv); \
+ if (SvMAGICAL(errsv)) { \
+ mg_free(errsv); \
+ } \
} \
} STMT_END
*svp = newSVpvs(""); \
} else if (SvREADONLY(*svp)) { \
SV *dupsv = newSVsv(*svp); \
- SvREFCNT_dec_NN(*svp); \
- *svp = dupsv; \
+ SvREFCNT_dec_NN(*svp); \
+ *svp = dupsv; \
} else { \
- SV *const errsv = *svp; \
- if (SvMAGICAL(errsv)) { \
- mg_free(errsv); \
- } \
+ SV *const errsv = *svp; \
+ if (SvMAGICAL(errsv)) { \
+ mg_free(errsv); \
+ } \
} \
} STMT_END
(SvREFCNT_dec(GvSV(PL_defgv)), GvSV(PL_defgv) = SvREFCNT_inc(sv))
# define SAVE_DEFSV \
( \
- save_gp(PL_defgv, 0), \
- GvINTRO_off(PL_defgv), \
- SAVEGENERICSV(GvSV(PL_defgv)), \
- GvSV(PL_defgv) = NULL \
+ save_gp(PL_defgv, 0), \
+ GvINTRO_off(PL_defgv), \
+ SAVEGENERICSV(GvSV(PL_defgv)), \
+ GvSV(PL_defgv) = NULL \
)
#else
# define DEFSV GvSVn(PL_defgv)
#endif
/*
-=for apidoc_section SV Handling
+=for apidoc_section $SV
=for apidoc Amn|SV *|DEFSV
Returns the SV associated with C<$_>
*/
#ifndef errno
- extern int errno; /* ANSI allows errno to be an lvalue expr.
- * For example in multithreaded environments
- * something like this might happen:
- * extern int *_errno(void);
- * #define errno (*_errno()) */
+ extern int errno; /* ANSI allows errno to be an lvalue expr.
+ * For example in multithreaded environments
+ * something like this might happen:
+ * extern int *_errno(void);
+ * #define errno (*_errno()) */
#endif
#define UNKNOWN_ERRNO_MSG "(unknown)"
* 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.
-=for apidoc_section String Handling
+=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<buffer>. Instead use
#endif
#ifndef PTR2ul
-# define PTR2ul(p) INT2PTR(unsigned long,p)
+# 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<C</INT2PTR>> instead.
+
+=cut
+*/
+
#define NUM2PTR(any,d) (any)(PTRV)(d)
#define PTR2IV(p) INT2PTR(IV,p)
#define PTR2UV(p) INT2PTR(UV,p)
# endif
#endif
-typedef NVTYPE NV;
+/* On MS Windows,with 64-bit mingw-w64 compilers, we
+ need to attend to a __float128 alignment issue if
+ USE_QUADMATH is defined. Otherwise we simply:
+ typedef NVTYPE NV
+ 32-bit mingw.org compilers might also require
+ aligned(32) - at least that's what I found with my
+ Math::Foat128 module. But this is as yet untested
+ here, so no allowance is being made for mingw.org
+ compilers at this stage. -- sisyphus January 2021
+*/
+#if (defined(USE_LONG_DOUBLE) || defined(USE_QUADMATH)) && defined(__MINGW64__)
+ /* 64-bit build, mingw-w64 compiler only */
+ typedef NVTYPE NV __attribute__ ((aligned(8)));
+#else
+ typedef NVTYPE NV;
+#endif
#ifdef I_IEEEFP
# include <ieeefp.h>
# define Perl_cos cosl
# define Perl_cosh coshl
# define Perl_exp expl
-/* no Perl_fabs, but there's PERL_ABS */
+# define Perl_fabs fabsl
# define Perl_floor floorl
# define Perl_fmod fmodl
# define Perl_log logl
# define Perl_cos cosq
# define Perl_cosh coshq
# define Perl_exp expq
-/* no Perl_fabs, but there's PERL_ABS */
+# define Perl_fabs fabsq
# define Perl_floor floorq
# define Perl_fmod fmodq
# define Perl_log logq
# define Perl_cos cos
# define Perl_cosh cosh
# define Perl_exp exp
-/* no Perl_fabs, but there's PERL_ABS */
+# define Perl_fabs fabs
# define Perl_floor floor
# define Perl_fmod fmod
# define Perl_log log
# define FP_QNAN FP_QNAN
# endif
# include <math.h>
-# ifdef I_IEEFP
+# ifdef I_IEEEFP
# include <ieeefp.h>
# endif
# ifdef I_FP
# define Perl_isfinitel(x) isfinitel(x)
# elif defined(HAS_FINITEL)
# define Perl_isfinitel(x) finitel(x)
-# elif defined(HAS_INFL) && defined(HAS_NANL)
+# elif defined(HAS_ISINFL) && defined(HAS_ISNANL)
# define Perl_isfinitel(x) !(isinfl(x)||isnanl(x))
# else
# define Perl_isfinitel(x) ((x) * 0 == 0) /* See Perl_isfinite. */
#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
#endif
/*
-=for apidoc_section Integer configuration values
+=for apidoc_section $integer
=for apidoc AmnU||PERL_INT_MAX
=for apidoc_item ||PERL_INT_MIN
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;
# define USE_ENVIRON_ARRAY
#endif
-#ifdef USE_ITHREADS
- /* On some platforms it would be safe to use a read/write mutex with many
- * readers possible at the same time. On other platforms, notably IBM ones,
- * subsequent getenv calls destroy earlier ones. Those platforms would not
- * be able to handle simultaneous getenv calls */
-# define ENV_LOCK MUTEX_LOCK(&PL_env_mutex)
-# define ENV_UNLOCK MUTEX_UNLOCK(&PL_env_mutex)
-# define ENV_INIT MUTEX_INIT(&PL_env_mutex);
-# define ENV_TERM MUTEX_DESTROY(&PL_env_mutex);
-#else
-# define ENV_LOCK NOOP;
-# define ENV_UNLOCK NOOP;
-# define ENV_INIT NOOP;
-# define ENV_TERM NOOP;
-#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
-
#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
#endif
/*
-=for apidoc_section Embedding and Interpreter Cloning
+=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
* documentation for details. */
#if defined(USE_ITHREADS)
-# ifdef NETWARE
-# include <nw5thread.h>
-# elif defined(WIN32)
+# if defined(WIN32)
# include <win32thread.h>
# elif defined(OS2)
# include "os2thread.h"
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;
+ SSize_t readers_count;
+} perl_RnW1_mutex_t;
+
+
#endif /* USE_ITHREADS */
#ifdef PERL_TSA_ACTIVE
# include "win32.h"
#endif
-#ifdef NETWARE
-# include "netware.h"
-#endif
-
#define STATUS_UNIX PL_statusvalue
#ifdef VMS
# define STATUS_NATIVE PL_statusvalue_vms
*/
# define STATUS_EXIT \
- (((I32)PL_statusvalue_vms == -1 ? SS$_ABORT : PL_statusvalue_vms) | \
- (VMSISH_HUSHED ? STS$M_INHIB_MSG : 0))
+ (((I32)PL_statusvalue_vms == -1 ? SS$_ABORT : PL_statusvalue_vms) | \
+ (VMSISH_HUSHED ? STS$M_INHIB_MSG : 0))
/* STATUS_NATIVE_CHILD_SET - Calculate UNIX status that matches the child
*/
# define STATUS_NATIVE_CHILD_SET(n) \
- STMT_START { \
- I32 evalue = (I32)n; \
- if (evalue == EVMSERR) { \
- PL_statusvalue_vms = vaxc$errno; \
- PL_statusvalue = evalue; \
- } else { \
- PL_statusvalue_vms = evalue; \
- if (evalue == -1) { \
- PL_statusvalue = -1; \
- PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \
- } else \
- PL_statusvalue = Perl_vms_status_to_unix(evalue, 1); \
- set_vaxc_errno(evalue); \
- if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX) \
- set_errno(EVMSERR); \
- else set_errno(Perl_vms_status_to_unix(evalue, 0)); \
- PL_statusvalue = PL_statusvalue << child_offset_bits; \
- } \
- } STMT_END
+ STMT_START { \
+ I32 evalue = (I32)n; \
+ if (evalue == EVMSERR) { \
+ PL_statusvalue_vms = vaxc$errno; \
+ PL_statusvalue = evalue; \
+ } else { \
+ PL_statusvalue_vms = evalue; \
+ if (evalue == -1) { \
+ PL_statusvalue = -1; \
+ PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \
+ } else \
+ PL_statusvalue = Perl_vms_status_to_unix(evalue, 1); \
+ set_vaxc_errno(evalue); \
+ if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX) \
+ set_errno(EVMSERR); \
+ else set_errno(Perl_vms_status_to_unix(evalue, 0)); \
+ PL_statusvalue = PL_statusvalue << child_offset_bits; \
+ } \
+ } STMT_END
# ifdef VMSISH_STATUS
# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX)
* This is used when Perl is forcing errno to have a specific value.
*/
# define STATUS_UNIX_SET(n) \
- STMT_START { \
- I32 evalue = (I32)n; \
- PL_statusvalue = evalue; \
- if (PL_statusvalue != -1) { \
- if (PL_statusvalue != EVMSERR) { \
- PL_statusvalue &= 0xFFFF; \
- if (MY_POSIX_EXIT) \
- PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\
- else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \
- } \
- else { \
- PL_statusvalue_vms = vaxc$errno; \
- } \
- } \
- else PL_statusvalue_vms = SS$_ABORT; \
- set_vaxc_errno(PL_statusvalue_vms); \
- } STMT_END
+ STMT_START { \
+ I32 evalue = (I32)n; \
+ PL_statusvalue = evalue; \
+ if (PL_statusvalue != -1) { \
+ if (PL_statusvalue != EVMSERR) { \
+ PL_statusvalue &= 0xFFFF; \
+ if (MY_POSIX_EXIT) \
+ PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\
+ else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \
+ } \
+ else { \
+ PL_statusvalue_vms = vaxc$errno; \
+ } \
+ } \
+ else PL_statusvalue_vms = SS$_ABORT; \
+ set_vaxc_errno(PL_statusvalue_vms); \
+ } STMT_END
/* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets
* the NATIVE error status based on it.
*/
# define STATUS_UNIX_EXIT_SET(n) \
- STMT_START { \
- I32 evalue = (I32)n; \
- PL_statusvalue = evalue; \
- if (MY_POSIX_EXIT) { \
- if (evalue <= 0xFF00) { \
- if (evalue > 0xFF) \
- evalue = (evalue >> child_offset_bits) & 0xFF; \
- PL_statusvalue_vms = \
- (C_FAC_POSIX | (evalue << 3 ) | \
- ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \
- } else /* forgive them Perl, for they have sinned */ \
- PL_statusvalue_vms = evalue; \
- } else { \
- if (evalue == 0) \
- PL_statusvalue_vms = SS$_NORMAL; \
- else if (evalue <= 0xFF00) \
- PL_statusvalue_vms = SS$_ABORT; \
- else { /* forgive them Perl, for they have sinned */ \
- if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \
- else PL_statusvalue_vms = vaxc$errno; \
- /* And obviously used a VMS status value instead of UNIX */ \
- PL_statusvalue = EVMSERR; \
- } \
- set_vaxc_errno(PL_statusvalue_vms); \
- } \
- } STMT_END
+ STMT_START { \
+ I32 evalue = (I32)n; \
+ PL_statusvalue = evalue; \
+ if (MY_POSIX_EXIT) { \
+ if (evalue <= 0xFF00) { \
+ if (evalue > 0xFF) \
+ evalue = ((U8) (evalue >> child_offset_bits)); \
+ PL_statusvalue_vms = \
+ (C_FAC_POSIX | (evalue << 3 ) | \
+ ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \
+ } else /* forgive them Perl, for they have sinned */ \
+ PL_statusvalue_vms = evalue; \
+ } else { \
+ if (evalue == 0) \
+ PL_statusvalue_vms = SS$_NORMAL; \
+ else if (evalue <= 0xFF00) \
+ PL_statusvalue_vms = SS$_ABORT; \
+ else { /* forgive them Perl, for they have sinned */ \
+ if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \
+ else PL_statusvalue_vms = vaxc$errno; \
+ /* And obviously used a VMS status value instead of UNIX */ \
+ PL_statusvalue = EVMSERR; \
+ } \
+ set_vaxc_errno(PL_statusvalue_vms); \
+ } \
+ } STMT_END
/* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code
*/
# define STATUS_EXIT_SET(n) \
- STMT_START { \
- I32 evalue = (I32)n; \
- PL_statusvalue = evalue; \
- if (MY_POSIX_EXIT) \
- if (evalue > 255) PL_statusvalue_vms = evalue; else { \
- PL_statusvalue_vms = \
- (C_FAC_POSIX | (evalue << 3 ) | \
- ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \
- else \
- PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \
- set_vaxc_errno(PL_statusvalue_vms); \
- } STMT_END
+ STMT_START { \
+ I32 evalue = (I32)n; \
+ PL_statusvalue = evalue; \
+ if (MY_POSIX_EXIT) \
+ if (evalue > 255) PL_statusvalue_vms = evalue; else { \
+ PL_statusvalue_vms = \
+ (C_FAC_POSIX | (evalue << 3 ) | \
+ ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \
+ else \
+ PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \
+ set_vaxc_errno(PL_statusvalue_vms); \
+ } STMT_END
/* This macro forces a success status */
# define STATUS_ALL_SUCCESS \
- (PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL)
+ (PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL)
/* This macro forces a failure status */
# define STATUS_ALL_FAILURE (PL_statusvalue = 1, \
vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \
- (C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT)
+ (C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT)
#elif defined(__amigaos4__)
/* A somewhat experimental attempt to simulate posix return code values */
} \
} STMT_END
# define STATUS_UNIX_SET(n) \
- STMT_START { \
- PL_statusvalue = (n); \
- if (PL_statusvalue != -1) \
- PL_statusvalue &= 0xFFFF; \
- } STMT_END
+ STMT_START { \
+ PL_statusvalue = (n); \
+ if (PL_statusvalue != -1) \
+ PL_statusvalue &= 0xFFFF; \
+ } STMT_END
# define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n)
# define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n)
# define STATUS_CURRENT STATUS_UNIX
} STMT_END
# endif
# define STATUS_UNIX_SET(n) \
- STMT_START { \
- PL_statusvalue = (n); \
- if (PL_statusvalue != -1) \
- PL_statusvalue &= 0xFFFF; \
- } STMT_END
+ STMT_START { \
+ PL_statusvalue = (n); \
+ if (PL_statusvalue != -1) \
+ PL_statusvalue &= 0xFFFF; \
+ } STMT_END
# define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n)
# define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n)
# define STATUS_CURRENT STATUS_UNIX
# define PERL_GET_INTERP (PL_curinterp)
#endif
-#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
-# ifdef MULTIPLICITY
-# define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT)
-# endif
+#if defined(MULTIPLICITY) && !defined(PERL_GET_THX)
+# define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT)
# define PERL_SET_THX(t) PERL_SET_CONTEXT(t)
#endif
#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<UVuf>, which you should convert to instead use
+
+=cut
+*/
# undef UVf
#elif !defined(UVf)
# define UVf UVuf
#endif
/*
-=for apidoc_section Compiler directives
+=for apidoc_section $directives
=for apidoc Am||LIKELY|bool expr
=cut
*/
-#ifdef DEBUGGING
-# define ASSUME(x) assert(x)
-# if __has_builtin(__builtin_unreachable)
+#if __has_builtin(__builtin_unreachable)
# define HAS_BUILTIN_UNREACHABLE
-# elif (defined(__GNUC__) && ( __GNUC__ > 4 \
- || __GNUC__ == 4 && __GNUC_MINOR__ >= 5))
+#elif PERL_GCC_VERSION_GE(4,5,0)
# 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
+#ifdef DEBUGGING
+# define ASSUME(x) assert(x)
+#elif defined(_MSC_VER)
+# define ASSUME(x) __assume(x)
+#elif defined(__ARMCC_VERSION) /* untested */
+# define ASSUME(x) __promise(x)
#elif defined(HAS_BUILTIN_UNREACHABLE)
-# ifndef ASSUME
+ /* Compilers can take the hint from something being unreachable */
# define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable())
-# endif
+#else
+ /* Not DEBUGGING, so assert() is a no-op, but 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
+
+#ifdef HAS_BUILTIN_UNREACHABLE
# define NOT_REACHED \
STMT_START { \
ASSUME(!"UNREACHABLE"); __builtin_unreachable(); \
} STMT_END
+# undef HAS_BUILTIN_UNREACHABLE /* Don't leak out this internal symbol */
+#elif ! defined(__GNUC__) && (defined(__sun) || defined(__hpux))
+ /* These just complain that NOT_REACHED isn't reached */
+# define NOT_REACHED
#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 */
-# define ASSUME(x) assert(x)
-# endif
-# define NOT_REACHED ASSUME(!"UNREACHABLE")
+# 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
#ifndef IOCPARM_LEN
# ifdef IOCPARM_MASK
- /* on BSDish systems we're safe */
+ /* on BSDish systems we're safe */
# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK)
# elif defined(_IOC_SIZE) && defined(__GLIBC__)
- /* on Linux systems we're safe; except when we're not [perl #38223] */
+ /* on Linux systems we're safe; except when we're not [perl #38223] */
# define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x))
# else
- /* otherwise guess at what's safe */
+ /* otherwise guess at what's safe */
# define IOCPARM_LEN(x) 256
# endif
#endif
#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len)
#define FILTER_DATA(idx) \
- (PL_parser ? AvARRAY(PL_parser->rsfp_filters)[idx] : NULL)
+ (PL_parser ? AvARRAY(PL_parser->rsfp_filters)[idx] : NULL)
#define FILTER_ISREADER(idx) \
- (PL_parser && PL_parser->rsfp_filters \
- && idx >= AvFILLp(PL_parser->rsfp_filters))
+ (PL_parser && PL_parser->rsfp_filters \
+ && idx >= AvFILLp(PL_parser->rsfp_filters))
#define PERL_FILTER_EXISTS(i) \
- (PL_parser && PL_parser->rsfp_filters \
- && (Size_t) (i) < av_count(PL_parser->rsfp_filters))
+ (PL_parser && 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)
/* macros to define bit-fields in structs. */
#ifndef PERL_BITFIELD8
+# ifdef HAS_NON_INT_BITFIELDS
# define PERL_BITFIELD8 U8
+# else
+# define PERL_BITFIELD8 unsigned
+# endif
#endif
#ifndef PERL_BITFIELD16
+# ifdef HAS_NON_INT_BITFIELDS
# define PERL_BITFIELD16 U16
+# else
+# define PERL_BITFIELD16 unsigned
+# endif
#endif
#ifndef PERL_BITFIELD32
+# ifdef HAS_NON_INT_BITFIELDS
# define PERL_BITFIELD32 U32
+# else
+# define PERL_BITFIELD32 unsigned
+# endif
#endif
#include "sv.h"
PERL_STATIC_INLINE U32
my_swap32(const U32 x) {
- return ((x & 0xFF) << 24) | ((x >> 24) & 0xFF)
+ return ((x & 0xFF) << 24) | ((x >> 24) & 0xFF)
| ((x & 0x0000FF00) << 8) | ((x & 0x00FF0000) >> 8);
}
the error message. Please check the value of the macro BYTEORDER, as defined
in config.h. The values of BYTEORDER we expect are
- big endian little endian
+ big endian little endian
32 bit 0x4321 0x1234
64 bit 0x87654321 0x12345678
# define htovs(x) vtohs(x)
#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
# define vtohl(x) ((((x)&0xFF)<<24) \
- +(((x)>>24)&0xFF) \
- +(((x)&0x0000FF00)<<8) \
- +(((x)&0x00FF0000)>>8) )
+ +(((x)>>24)&0xFF) \
+ +(((x)&0x0000FF00)<<8) \
+ +(((x)&0x00FF0000)>>8) )
# define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
# define htovl(x) vtohl(x)
# define htovs(x) vtohs(x)
out of range floating point values to integers *is* undefined behaviour,
and it is starting to bite.
-=for apidoc_section Casting
+=for apidoc_section $casting
=for apidoc Am|I32|I_32|NV what
Cast an NV to I32 while avoiding undefined C behavior
#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
#define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX)
/* Used with UV/IV arguments: */
- /* XXXX: need to speed it up */
+ /* XXXX: need to speed it up */
#define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv))
#define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv))
#ifndef Perl_error_log
# define Perl_error_log (PL_stderrgv \
- && isGV(PL_stderrgv) \
- && GvIOp(PL_stderrgv) \
- && IoOFP(GvIOp(PL_stderrgv)) \
- ? IoOFP(GvIOp(PL_stderrgv)) \
- : PerlIO_stderr())
+ && isGV(PL_stderrgv) \
+ && GvIOp(PL_stderrgv) \
+ && IoOFP(GvIOp(PL_stderrgv)) \
+ ? IoOFP(GvIOp(PL_stderrgv)) \
+ : PerlIO_stderr())
#endif
#define DEBUG_u_FLAG 0x00000800 /* 2048 */
/* U is reserved for Unofficial, exploratory hacking */
#define DEBUG_U_FLAG 0x00001000 /* 4096 */
-/* spare 8192 */
+#define DEBUG_h_FLAG 0x00002000 /* 8192 */
#define DEBUG_X_FLAG 0x00004000 /* 16384 */
#define DEBUG_D_FLAG 0x00008000 /* 32768 */
#define DEBUG_S_FLAG 0x00010000 /* 65536 */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* -D was given --> PL_debug |= FLAG */
+/* Both flags have to be set */
+# define DEBUG_BOTH_FLAGS_TEST_(flag1, flag2) \
+ UNLIKELY((PL_debug & ((flag1)|(flag2))) \
+ == ((flag1)|(flag2)))
+
# define DEBUG_p_TEST_ UNLIKELY(PL_debug & DEBUG_p_FLAG)
# define DEBUG_s_TEST_ UNLIKELY(PL_debug & DEBUG_s_FLAG)
# define DEBUG_l_TEST_ UNLIKELY(PL_debug & DEBUG_l_FLAG)
# define DEBUG_x_TEST_ UNLIKELY(PL_debug & DEBUG_x_FLAG)
# define DEBUG_u_TEST_ UNLIKELY(PL_debug & DEBUG_u_FLAG)
# define DEBUG_U_TEST_ UNLIKELY(PL_debug & DEBUG_U_FLAG)
+# define DEBUG_h_TEST_ UNLIKELY(PL_debug & DEBUG_h_FLAG)
# define DEBUG_X_TEST_ UNLIKELY(PL_debug & DEBUG_X_FLAG)
# define DEBUG_D_TEST_ UNLIKELY(PL_debug & DEBUG_D_FLAG)
# define DEBUG_S_TEST_ UNLIKELY(PL_debug & DEBUG_S_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_)
+# define DEBUG_Xv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_X_FLAG, DEBUG_v_FLAG)
+# define DEBUG_Uv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_U_FLAG, DEBUG_v_FLAG)
+# define DEBUG_Pv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_P_FLAG, DEBUG_v_FLAG)
+# define DEBUG_Lv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_L_FLAG, DEBUG_v_FLAG)
+# define DEBUG_yv_TEST_ DEBUG_BOTH_FLAGS_TEST_(DEBUG_y_FLAG, DEBUG_v_FLAG)
#ifdef DEBUGGING
# define DEBUG_x_TEST DEBUG_x_TEST_
# define DEBUG_u_TEST DEBUG_u_TEST_
# define DEBUG_U_TEST DEBUG_U_TEST_
+# define DEBUG_h_TEST DEBUG_h_TEST_
# define DEBUG_X_TEST DEBUG_X_TEST_
# define DEBUG_D_TEST DEBUG_D_TEST_
# define DEBUG_S_TEST DEBUG_S_TEST_
} \
} STMT_END
+/* These allow you to customize your debugging output for specialized,
+ * generally temporary ad-hoc purposes. For example, if you need 'errno'
+ * preserved, you can add definitions to these macros (either in this file for
+ * the whole program, or before the #include "perl.h" in a particular .c file
+ * you're trying to debug) and recompile:
+ *
+ * #define DEBUG_PRE_STMTS dSAVE_ERRNO;
+ * #define DEBUG_POST_STMTS RESTORE_ERRNO;
+ *
+ * Other potential things include displaying timestamps, location information,
+ * which thread, etc. Heres an example with both errno and location info:
+ *
+ * #define DEBUG_PRE_STMTS dSAVE_ERRNO; \
+ * PerlIO_printf(Perl_debug_log, "%s:%d: ", __FILE__, __LINE__);
+ * #define DEBUG_POST RESTORE_ERRNO;
+ *
+ * All DEBUG statements in the compiled scope will be have these extra
+ * statements compiled in; they will be executed only for the DEBUG statements
+ * whose flags are turned on.
+ */
+#ifndef DEBUG_PRE_STMTS
+# define DEBUG_PRE_STMTS
+#endif
+#ifndef DEBUG_POST_STMTS
+# define DEBUG_POST_STMTS
+#endif
+
# define DEBUG__(t, a) \
STMT_START { \
- if (t) STMT_START {a;} STMT_END; \
+ if (t) STMT_START { \
+ DEBUG_PRE_STMTS a; DEBUG_POST_STMTS \
+ } STMT_END; \
} STMT_END
# define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
/* 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
+# define DEBUG_r(a) STMT_START { \
+ DEBUG_PRE_STMTS a; DEBUG_POST_STMTS \
+ } STMT_END;
# else
# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
# endif /* PERL_EXT_RE_BUILD */
# define DEBUG_x_TEST (0)
# define DEBUG_u_TEST (0)
# define DEBUG_U_TEST (0)
+# define DEBUG_h_TEST (0)
# define DEBUG_X_TEST (0)
# define DEBUG_D_TEST (0)
# define DEBUG_S_TEST (0)
#define DEBUG_SCOPE(where) \
DEBUG_l( \
Perl_deb(aTHX_ "%s scope %ld (savestack=%ld) at %s:%d\n", \
- where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \
- __FILE__, __LINE__));
+ where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \
+ __FILE__, __LINE__));
/* Keep the old croak based assert for those who want it, and as a fallback if
the platform is so heretically non-ANSI that it can't assert. */
#define Perl_assert(what) PERL_DEB2( \
- ((what) ? ((void) 0) : \
- (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \
- "\", line %d", STRINGIFY(what), __LINE__), \
+ ((what) ? ((void) 0) : \
+ (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \
+ "\", line %d", STRINGIFY(what), __LINE__), \
(void) 0)), ((void)0))
/* assert() gets defined if DEBUGGING.
# ifdef USE_ITHREADS
# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex)
# define PERLIO_TERM \
- STMT_START { \
- PerlIO_teardown(); \
- MUTEX_DESTROY(&PL_perlio_mutex);\
- } STMT_END
+ STMT_START { \
+ PerlIO_teardown(); \
+ MUTEX_DESTROY(&PL_perlio_mutex);\
+ } STMT_END
# else
# define PERLIO_INIT
# define PERLIO_TERM PerlIO_teardown()
#ifdef MYMALLOC
# ifdef MUTEX_INIT_CALLS_MALLOC
# define MALLOC_INIT \
- STMT_START { \
- PL_malloc_mutex = NULL; \
- MUTEX_INIT(&PL_malloc_mutex); \
- } STMT_END
+ STMT_START { \
+ PL_malloc_mutex = NULL; \
+ MUTEX_INIT(&PL_malloc_mutex); \
+ } STMT_END
# define MALLOC_TERM \
- STMT_START { \
- perl_mutex tmp = PL_malloc_mutex; \
- PL_malloc_mutex = NULL; \
- MUTEX_DESTROY(&tmp); \
- } STMT_END
+ STMT_START { \
+ perl_mutex tmp = PL_malloc_mutex; \
+ PL_malloc_mutex = NULL; \
+ MUTEX_DESTROY(&tmp); \
+ } STMT_END
# else
# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
# define MALLOC_TERM
#endif
-#if defined(PERL_IMPLICIT_CONTEXT)
+#if defined(MULTIPLICITY)
struct perl_memory_debug_header;
struct perl_memory_debug_header {
# define PERL_MEMORY_DEBUG_HEADER_SIZE \
(sizeof(struct perl_memory_debug_header) + \
- (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
- %MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
+ (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
+ %MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
#else
# define PERL_MEMORY_DEBUG_HEADER_SIZE 0
#ifdef PERL_TRACK_MEMPOOL
# ifdef PERL_DEBUG_READONLY_COW
# define INIT_TRACK_MEMPOOL(header, interp) \
- STMT_START { \
- (header).interpreter = (interp); \
- (header).prev = (header).next = &(header); \
- (header).readonly = 0; \
- } STMT_END
+ STMT_START { \
+ (header).interpreter = (interp); \
+ (header).prev = (header).next = &(header); \
+ (header).readonly = 0; \
+ } STMT_END
# else
# define INIT_TRACK_MEMPOOL(header, interp) \
- STMT_START { \
- (header).interpreter = (interp); \
- (header).prev = (header).next = &(header); \
- } STMT_END
+ STMT_START { \
+ (header).interpreter = (interp); \
+ (header).prev = (header).next = &(header); \
+ } STMT_END
# endif
# else
# define INIT_TRACK_MEMPOOL(header, interp)
# if defined(HAS_MALLOC_SIZE) && !defined(PERL_DEBUG_READONLY_COW)
# ifdef PERL_TRACK_MEMPOOL
# define Perl_safesysmalloc_size(where) \
- (malloc_size(((char *)(where)) - PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE)
+ (malloc_size(((char *)(where)) - PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE)
# else
# define Perl_safesysmalloc_size(where) malloc_size(where)
# endif
# ifdef HAS_MALLOC_GOOD_SIZE
# ifdef PERL_TRACK_MEMPOOL
# define Perl_malloc_good_size(how_much) \
- (malloc_good_size((how_much) + PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE)
+ (malloc_good_size((how_much) + PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE)
# else
# define Perl_malloc_good_size(how_much) malloc_good_size(how_much)
# endif
#undef PERL_PATCHLEVEL_H_IMPLICIT
#define PERL_VERSION_STRING STRINGIFY(PERL_REVISION) "." \
- STRINGIFY(PERL_VERSION) "." \
- STRINGIFY(PERL_SUBVERSION)
+ STRINGIFY(PERL_VERSION) "." \
+ STRINGIFY(PERL_SUBVERSION)
#define PERL_API_VERSION_STRING STRINGIFY(PERL_API_REVISION) "." \
- STRINGIFY(PERL_API_VERSION) "." \
- STRINGIFY(PERL_API_SUBVERSION)
+ STRINGIFY(PERL_API_VERSION) "." \
+ STRINGIFY(PERL_API_SUBVERSION)
START_EXTERN_C
INIT("0");
/*
-=for apidoc_section Numeric Functions
+=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
* 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
+ 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
};
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
+ 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_latin1[] = {
* not one, so can't be represented in this table.
*
* All have to be specially handled */
- 0, 1, 2, 3, 4, 5, 6, 7,
- 8, 9, 10, 11, 12, 13, 14, 15,
- 16, 17, 18, 19, 20, 21, 22, 23,
- 24, 25, 26, 27, 28, 29, 30, 31,
- 32, 33, 34, 35, 36, 37, 38, 39,
- 40, 41, 42, 43, 44, 45, 46, 47,
- 48, 49, 50, 51, 52, 53, 54, 55,
- 56, 57, 58, 59, 60, 61, 62, 63,
- 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g',
- 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
- 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
- 'x', 'y', 'z', 91, 92, 93, 94, 95,
- 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G',
- 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
- 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
- 'X', 'Y', 'Z', 123, 124, 125, 126, 127,
- 128, 129, 130, 131, 132, 133, 134, 135,
- 136, 137, 138, 139, 140, 141, 142, 143,
- 144, 145, 146, 147, 148, 149, 150, 151,
- 152, 153, 154, 155, 156, 157, 158, 159,
- 160, 161, 162, 163, 164, 165, 166, 167,
- 168, 169, 170, 171, 172, 173, 174, 175,
- 176, 177, 178, 179, 180, 181 /*micro */, 182, 183,
- 184, 185, 186, 187, 188, 189, 190, 191,
- 192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32,
- 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32,
- 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215,
- 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223 /* ss */,
- 224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32,
- 232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32,
- 240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247,
- 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32,
- 255 /* y with diaeresis */
+ 0, 1, 2, 3, 4, 5, 6, 7,
+ 8, 9, 10, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 20, 21, 22, 23,
+ 24, 25, 26, 27, 28, 29, 30, 31,
+ 32, 33, 34, 35, 36, 37, 38, 39,
+ 40, 41, 42, 43, 44, 45, 46, 47,
+ 48, 49, 50, 51, 52, 53, 54, 55,
+ 56, 57, 58, 59, 60, 61, 62, 63,
+ 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
+ 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
+ 'x', 'y', 'z', 91, 92, 93, 94, 95,
+ 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
+ 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
+ 'X', 'Y', 'Z', 123, 124, 125, 126, 127,
+ 128, 129, 130, 131, 132, 133, 134, 135,
+ 136, 137, 138, 139, 140, 141, 142, 143,
+ 144, 145, 146, 147, 148, 149, 150, 151,
+ 152, 153, 154, 155, 156, 157, 158, 159,
+ 160, 161, 162, 163, 164, 165, 166, 167,
+ 168, 169, 170, 171, 172, 173, 174, 175,
+ 176, 177, 178, 179, 180, 181 /*micro */, 182, 183,
+ 184, 185, 186, 187, 188, 189, 190, 191,
+ 192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32,
+ 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32,
+ 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215,
+ 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223 /* ss */,
+ 224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32,
+ 232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32,
+ 240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247,
+ 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32,
+ 255 /* y with diaeresis */
};
/* If these tables are accessed through ebcdic, the access will be converted to
* latin1 first */
EXTCONST unsigned char PL_latin1_lc[] = { /* lowercasing */
- 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, 97, 98, 99, 100, 101, 102, 103,
- 104, 105, 106, 107, 108, 109, 110, 111,
- 112, 113, 114, 115, 116, 117, 118, 119,
- 120, 121, 122, 123, 124, 125, 126, 127,
- 128, 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+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32,
- 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32,
- 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215,
- 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223,
- 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
+ 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, 97, 98, 99, 100, 101, 102, 103,
+ 104, 105, 106, 107, 108, 109, 110, 111,
+ 112, 113, 114, 115, 116, 117, 118, 119,
+ 120, 121, 122, 123, 124, 125, 126, 127,
+ 128, 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+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32,
+ 200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32,
+ 208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215,
+ 216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223,
+ 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
};
/* upper and title case of latin1 characters, modified so that the three tricky
* ones are mapped to 255 (which is one of the three) */
EXTCONST unsigned char PL_mod_latin1_uc[] = {
- 0, 1, 2, 3, 4, 5, 6, 7,
- 8, 9, 10, 11, 12, 13, 14, 15,
- 16, 17, 18, 19, 20, 21, 22, 23,
- 24, 25, 26, 27, 28, 29, 30, 31,
- 32, 33, 34, 35, 36, 37, 38, 39,
- 40, 41, 42, 43, 44, 45, 46, 47,
- 48, 49, 50, 51, 52, 53, 54, 55,
- 56, 57, 58, 59, 60, 61, 62, 63,
- 64, 65, 66, 67, 68, 69, 70, 71,
- 72, 73, 74, 75, 76, 77, 78, 79,
- 80, 81, 82, 83, 84, 85, 86, 87,
- 88, 89, 90, 91, 92, 93, 94, 95,
- 96, '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, 255 /*micro*/, 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,
+ 0, 1, 2, 3, 4, 5, 6, 7,
+ 8, 9, 10, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 20, 21, 22, 23,
+ 24, 25, 26, 27, 28, 29, 30, 31,
+ 32, 33, 34, 35, 36, 37, 38, 39,
+ 40, 41, 42, 43, 44, 45, 46, 47,
+ 48, 49, 50, 51, 52, 53, 54, 55,
+ 56, 57, 58, 59, 60, 61, 62, 63,
+ 64, 65, 66, 67, 68, 69, 70, 71,
+ 72, 73, 74, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 87,
+ 88, 89, 90, 91, 92, 93, 94, 95,
+ 96, '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, 255 /*micro*/, 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,
# if UNICODE_MAJOR_VERSION > 2 \
|| (UNICODE_MAJOR_VERSION == 2 && UNICODE_DOT_VERSION >= 1 \
&& UNICODE_DOT_DOT_VERSION >= 8)
- 255 /*sharp s*/,
+ 255 /*sharp s*/,
# else /* uc(sharp s) is 'sharp s' itself in early unicode */
- 223,
+ 223,
# 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
+ 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 */
#else /* ! DOINIT */
* which has DEBUGGING enabled always */
#ifdef DOINIT
EXTCONST char* const PL_block_type[] = {
- "NULL",
- "WHEN",
- "BLOCK",
- "GIVEN",
- "LOOP_ARY",
- "LOOP_LAZYSV",
- "LOOP_LAZYIV",
- "LOOP_LIST",
- "LOOP_PLAIN",
- "SUB",
- "FORMAT",
- "EVAL",
- "SUBST"
+ "NULL",
+ "WHEN",
+ "BLOCK",
+ "GIVEN",
+ "LOOP_ARY",
+ "LOOP_LAZYSV",
+ "LOOP_LAZYIV",
+ "LOOP_LIST",
+ "LOOP_PLAIN",
+ "SUB",
+ "FORMAT",
+ "EVAL",
+ "SUBST",
+ "DEFER"
};
#else
EXTCONST char* PL_block_type[];
#ifdef DOINIT
EXTCONST char PL_bincompat_options[] =
# ifdef DEBUG_LEAKING_SCALARS
- " DEBUG_LEAKING_SCALARS"
+ " DEBUG_LEAKING_SCALARS"
# endif
# ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
- " DEBUG_LEAKING_SCALARS_FORK_DUMP"
+ " DEBUG_LEAKING_SCALARS_FORK_DUMP"
# endif
# ifdef HAS_TIMES
- " HAS_TIMES"
+ " HAS_TIMES"
# endif
# ifdef HAVE_INTERP_INTERN
- " HAVE_INTERP_INTERN"
+ " HAVE_INTERP_INTERN"
# endif
# ifdef MULTIPLICITY
- " MULTIPLICITY"
+ " MULTIPLICITY"
# endif
# ifdef MYMALLOC
- " MYMALLOC"
+ " MYMALLOC"
# endif
# ifdef PERLIO_LAYERS
- " PERLIO_LAYERS"
+ " PERLIO_LAYERS"
# endif
# ifdef PERL_DEBUG_READONLY_COW
- " PERL_DEBUG_READONLY_COW"
+ " PERL_DEBUG_READONLY_COW"
# endif
# ifdef PERL_DEBUG_READONLY_OPS
- " PERL_DEBUG_READONLY_OPS"
-# endif
-# ifdef PERL_IMPLICIT_CONTEXT
- " PERL_IMPLICIT_CONTEXT"
+ " PERL_DEBUG_READONLY_OPS"
# endif
# ifdef PERL_IMPLICIT_SYS
- " PERL_IMPLICIT_SYS"
+ " PERL_IMPLICIT_SYS"
# endif
# ifdef PERL_MICRO
- " PERL_MICRO"
+ " PERL_MICRO"
# endif
# ifdef PERL_POISON
- " PERL_POISON"
+ " PERL_POISON"
# endif
# ifdef PERL_SAWAMPERSAND
- " PERL_SAWAMPERSAND"
+ " PERL_SAWAMPERSAND"
# endif
# ifdef PERL_TRACK_MEMPOOL
- " PERL_TRACK_MEMPOOL"
+ " PERL_TRACK_MEMPOOL"
# endif
# ifdef PERL_USES_PL_PIDSTATUS
- " PERL_USES_PL_PIDSTATUS"
+ " PERL_USES_PL_PIDSTATUS"
# endif
# ifdef USE_64_BIT_ALL
- " USE_64_BIT_ALL"
+ " USE_64_BIT_ALL"
# endif
# ifdef USE_64_BIT_INT
- " USE_64_BIT_INT"
+ " USE_64_BIT_INT"
# endif
# ifdef USE_IEEE
- " USE_IEEE"
+ " USE_IEEE"
# endif
# ifdef USE_ITHREADS
- " USE_ITHREADS"
+ " USE_ITHREADS"
# endif
# ifdef USE_LARGE_FILES
- " USE_LARGE_FILES"
+ " USE_LARGE_FILES"
# endif
# ifdef USE_LOCALE_COLLATE
- " USE_LOCALE_COLLATE"
+ " USE_LOCALE_COLLATE"
# endif
# ifdef USE_LOCALE_NUMERIC
- " USE_LOCALE_NUMERIC"
+ " USE_LOCALE_NUMERIC"
# endif
# ifdef USE_LOCALE_TIME
- " USE_LOCALE_TIME"
+ " USE_LOCALE_TIME"
# endif
# ifdef USE_LONG_DOUBLE
- " USE_LONG_DOUBLE"
+ " USE_LONG_DOUBLE"
# endif
# ifdef USE_PERLIO
- " USE_PERLIO"
+ " USE_PERLIO"
# endif
# ifdef USE_QUADMATH
- " USE_QUADMATH"
+ " USE_QUADMATH"
# endif
# ifdef USE_REENTRANT_API
- " USE_REENTRANT_API"
+ " USE_REENTRANT_API"
# endif
# ifdef USE_SOCKS
- " USE_SOCKS"
+ " USE_SOCKS"
# endif
# ifdef VMS_DO_SOCKETS
- " VMS_DO_SOCKETS"
+ " VMS_DO_SOCKETS"
# endif
# ifdef VMS_SHORTEN_LONG_SYMBOLS
- " VMS_SHORTEN_LONG_SYMBOLS"
+ " VMS_SHORTEN_LONG_SYMBOLS"
# endif
# ifdef VMS_WE_ARE_CASE_SENSITIVE
- " VMS_SYMBOL_CASE_AS_IS"
+ " VMS_SYMBOL_CASE_AS_IS"
# endif
"";
#else
EXTCONST char *const PL_phase_names[];
#endif
+/*
+=for apidoc_section $utility
+
+=for apidoc phase_name
+
+Returns the given phase's name as a NUL-terminated string.
+
+For example, to print a stack trace that includes the current
+interpreter phase you might do:
+
+ const char* phase_name = phase_name(PL_phase);
+ mess("This is weird. (Perl phase: %s)", phase_name);
+
+=cut
+*/
+
+#define phase_name(phase) (PL_phase_names[phase])
+
#ifndef PERL_CORE
/* Do not use this macro. It only exists for extensions that rely on PL_dirty
* instead of using the newer PL_phase, which provides everything PL_dirty
#define KEY_sigvar 0xFFFF /* fake keyword representing a signature var */
/* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer
- special and there is no need for HINT_PRIVATE_MASK for COPs
- However, bitops store HINT_INTEGER in their op_private.
+ special and there is no need for HINT_PRIVATE_MASK for COPs.
NOTE: The typical module using these has the bit value hard-coded, so don't
blindly change the values of these.
#define HINT_FEATURE_MASK 0x3c000000 /* 4 bits for feature bundles */
- /* Note: Used for HINT_M_VMSISH_*,
- currently defined by vms/vmsish.h:
- 0x40000000
- 0x80000000
- */
-
-/* The following are stored in $^H{sort}, not in PL_hints */
-#define HINT_SORT_STABLE 0x00000100 /* sort styles */
-#define HINT_SORT_UNSTABLE 0x00000200
+ /* Note: Used for HINT_M_VMSISH_*,
+ currently defined by vms/vmsish.h:
+ 0x40000000
+ 0x80000000
+ */
#define HINT_ALL_STRICT HINT_STRICT_REFS \
| HINT_STRICT_SUBS \
#ifndef PERL_SAWAMPERSAND
# define PL_sawampersand \
- (SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT)
+ (SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT)
#endif
/* Used for debugvar magic */
#define PERL_DEBUG_PAD(i) &(PL_debug_pad.pad[i])
#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, \
- (((XPV*) SvANY(PERL_DEBUG_PAD(i)))->xpv_cur = 0), \
- PERL_DEBUG_PAD(i))
+ (((XPV*) SvANY(PERL_DEBUG_PAD(i)))->xpv_cur = 0), \
+ PERL_DEBUG_PAD(i))
/* Enable variables which are pointers to functions */
typedef void (*peep_t)(pTHX_ OP* o);
typedef regexp* (*regcomp_t) (pTHX_ char* exp, char* xend, PMOP* pm);
typedef I32 (*regexec_t) (pTHX_ regexp* prog, char* stringarg,
- char* strend, char* strbeg, I32 minend,
- SV* screamer, void* data, U32 flags);
+ char* strend, char* strbeg, I32 minend,
+ SV* screamer, void* data, U32 flags);
typedef char* (*re_intuit_start_t) (pTHX_ regexp *prog, SV *sv,
- char *strpos, char *strend,
- U32 flags,
- re_scream_pos_data *d);
+ char *strpos, char *strend,
+ U32 flags,
+ re_scream_pos_data *d);
typedef SV* (*re_intuit_string_t) (pTHX_ regexp *prog);
typedef void (*regfree_t) (pTHX_ struct regexp* r);
typedef regexp* (*regdupe_t) (pTHX_ const regexp* r, CLONE_PARAMS *param);
#endif
#ifdef DOINIT
- /* NL IV NV PV INV PI PN MG RX GV LV AV HV CV FM IO */
+ /* NL IV NV PV INV PI PN MG RX GV LV AV HV CV FM IO */
EXTCONST bool
PL_valid_types_IVX[] = { 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
EXTCONST bool
EXTCONST bool
PL_valid_types_NV_set[] = { 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 };
+EXTCONST U8
+PL_deBruijn_bitpos_tab32[] = {
+ /* https://graphics.stanford.edu/~seander/bithacks.html#IntegerLogDeBruijn */
+ 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,
+ 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9
+};
+
+EXTCONST U8
+PL_deBruijn_bitpos_tab64[] = {
+ /* https://stackoverflow.com/questions/11376288/fast-computing-of-log2-for-64-bit-integers */
+ 63, 0, 58, 1, 59, 47, 53, 2, 60, 39, 48, 27, 54, 33, 42, 3,
+ 61, 51, 37, 40, 49, 18, 28, 20, 55, 30, 34, 11, 43, 14, 22, 4,
+ 62, 57, 46, 52, 38, 26, 32, 41, 50, 36, 17, 19, 29, 10, 13, 21,
+ 56, 45, 25, 31, 35, 16, 9, 12, 44, 24, 15, 8, 23, 7, 6, 5
+};
+
#else
EXTCONST bool PL_valid_types_IVX[];
EXTCONST bool PL_valid_types_RV[];
EXTCONST bool PL_valid_types_IV_set[];
EXTCONST bool PL_valid_types_NV_set[];
+EXTCONST U8 PL_deBruijn_bitpos_tab32[];
+EXTCONST U8 PL_deBruijn_bitpos_tab64[];
#endif
+/* The constants for using PL_deBruijn_bitpos_tab */
+#define PERL_deBruijnMagic32_ 0x077CB531
+#define PERL_deBruijnShift32_ 27
+#define PERL_deBruijnMagic64_ 0x07EDD5E59A4E28C2
+#define PERL_deBruijnShift64_ 58
+
/* In C99 we could use designated (named field) union initializers.
* In C89 we need to initialize the member declared first.
* In C++ we need extern C initializers.
/* This is a version of the above table customized for Perl that doesn't
* exclude surrogates and accepts start bytes up through FD (FE on 64-bit
* machines). The classes have been renumbered so that the patterns are more
- * evident in the table. The class numbers for start bytes are constrained so
- * that they can be used as a shift count for masking off the leading one bits.
+ * evident in the table. The class numbers are structured so the values are:
+ *
+ * a) UTF-8 invariant code points
+ * 0
+ * b) Start bytes that always lead to either overlongs or some class of code
+ * point that needs outside intervention for handling (such as to raise a
+ * warning)
+ * 1
+ * c) Start bytes that never lead to one of the above
+ * number of bytes in complete sequence
+ * d) Rest of start bytes (they can be resolved through this algorithm) and
+ * continuation bytes
+ * arbitrary class number chosen to not conflict with the above
+ * classes, and to index into the remaining table
+ *
* It would make the code simpler if start byte FF could also be handled, but
- * doing so would mean adding nodes for each of continuation bytes 6-12
- * remaining, and two more nodes for overlong detection (a total of 9), and
- * there is room only for 4 more nodes unless we make the array U16 instead of
- * U8.
+ * doing so would mean adding two more classes (one from splitting 80 from 81,
+ * and one for FF), and nodes for each of 6 new continuation bytes. The
+ * current table has 436 entries; the new one would require 140 more = 576 (2
+ * additional classes for each of the 10 existing nodes, and 20 for each of 6
+ * new nodes. The array would have to be made U16 instead of U8, not worth it
+ * for this rarely encountered case
*
* The classes are
- * 00-7F 0
+ * 00-7F 0 Always legal, single byte sequence
* 80-81 7 Not legal immediately after start bytes E0 F0 F8 FC
* FE
* 82-83 8 Not legal immediately after start bytes E0 F0 F8 FC
* 84-87 9 Not legal immediately after start bytes E0 F0 F8
* 88-8F 10 Not legal immediately after start bytes E0 F0
* 90-9F 11 Not legal immediately after start byte E0
- * A0-BF 12
- * C0,C1 1
- * C2-DF 2
- * E0 13
- * E1-EF 3
- * F0 14
- * F1-F7 4
- * F8 15
- * F9-FB 5
- * FC 16
- * FD 6
- * FE 17 (or 1 on 32-bit machines, since it overflows)
- * FF 1
+ * A0-BF 12 Always legal continuation byte
+ * C0,C1 1 Not legal: overlong
+ * C2-DF 2 Legal start byte for two byte sequences
+ * E0 13 Some sequences are overlong; others legal
+ * E1-EF 3 Legal start byte for three byte sequences
+ * F0 14 Some sequences are overlong; others legal
+ * F1-F7 4 Legal start byte for four byte sequences
+ * F8 15 Some sequences are overlong; others legal
+ * F9-FB 5 Legal start byte for five byte sequences
+ * FC 16 Some sequences are overlong; others legal
+ * FD 6 Legal start byte for six byte sequences
+ * FE 17 Some sequences are overlong; others legal
+ * (is 1 on 32-bit machines, since it overflows)
+ * FF 1 Need to handle specially
*/
EXTCONST U8 PL_extended_utf8_dfa_tab[] = {
* N10 Start byte is FE. Continuation bytes 80-81 are illegal (overlong);
* the other continuations transition to N5
* 1 Reject. All transitions not mentioned above (except the single
- * byte ones (as they are always legal) are to this state.
+ * byte ones (as they are always legal)) are to this state.
*/
# if defined(PERL_CORE)
# 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 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
#endif /* _FASTMATH */
#define PERLDB_ALL (PERLDBf_SUB | PERLDBf_LINE | \
- PERLDBf_NOOPT | PERLDBf_INTER | \
- PERLDBf_SUBLINE| PERLDBf_SINGLE| \
- PERLDBf_NAMEEVAL| PERLDBf_NAMEANON | \
- PERLDBf_SAVESRC)
- /* No _NONAME, _GOTO */
+ PERLDBf_NOOPT | PERLDBf_INTER | \
+ PERLDBf_SUBLINE| PERLDBf_SINGLE| \
+ PERLDBf_NAMEEVAL| PERLDBf_NAMEANON | \
+ PERLDBf_SAVESRC)
+ /* No _NONAME, _GOTO */
#define PERLDBf_SUB 0x01 /* Debug sub enter/exit */
#define PERLDBf_LINE 0x02 /* Keep line # */
#define PERLDBf_NOOPT 0x04 /* Switch off optimizations */
#define PERLDBf_INTER 0x08 /* Preserve more data for
- later inspections */
+ later inspections */
#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines */
#define PERLDBf_SINGLE 0x20 /* Start with single-step on */
#define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr */
cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
/*
-=for apidoc_section Locales
+=for apidoc_section $locale
=for apidoc Amn|bool|IN_LOCALE
* argument; the 2nd, is a pointer to the first byte of the UTF-8 encoded
* string, and an end position which it won't try to read past */
# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(cp) \
- STMT_START { \
+ STMT_START { \
if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
"Wide character (U+%" UVXf ") in %s",\
} STMT_END
# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \
- STMT_START { /* Check if to warn before doing the conversion work */\
+ STMT_START { /* Check if to warn before doing the conversion work */\
if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
UV cp = utf8_to_uvchr_buf((U8 *) (s), (U8 *) (send), NULL); \
Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
#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
*
* 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 { \
} 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
* operations used by Perl, namely the decimal point, and even the thousands
* separator.)
-=for apidoc_section Locales
+=for apidoc_section $locale
=for apidoc Amn|void|DECLARATION_FOR_LC_NUMERIC_MANIPULATION
/* The next two macros set unconditionally. These should be rarely used, and
* only after being sure that this is what is needed */
# define SET_NUMERIC_STANDARD() \
- STMT_START { \
+ STMT_START { \
DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
"%s: %d: lc_numeric standard=%d\n", \
__FILE__, __LINE__, PL_numeric_standard)); \
} STMT_END
# define SET_NUMERIC_UNDERLYING() \
- STMT_START { \
+ STMT_START { \
if (_NOT_IN_NUMERIC_UNDERLYING) { \
Perl_set_numeric_underlying(aTHX); \
} \
/* Rarely, we want to change to the underlying locale even outside of 'use
* locale'. This is principally in the POSIX:: functions */
# define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() \
- STMT_START { \
+ STMT_START { \
LC_NUMERIC_LOCK(_NOT_IN_NUMERIC_UNDERLYING); \
if (_NOT_IN_NUMERIC_UNDERLYING) { \
Perl_set_numeric_underlying(aTHX); \
# define LOCK_LC_NUMERIC_STANDARD() \
STMT_START { \
DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
- "%s: %d: lock lc_numeric_standard: new depth=%d\n", \
- __FILE__, __LINE__, PL_numeric_standard + 1)); \
+ "%s: %d: lc_numeric_standard now locked to depth %d\n", \
+ __FILE__, __LINE__, PL_numeric_standard)); \
__ASSERT_(PL_numeric_standard) \
PL_numeric_standard++; \
} STMT_END
assert(0); \
} \
DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
- "%s: %d: lc_numeric_standard decrement lock, new depth=%d\n", \
- __FILE__, __LINE__, PL_numeric_standard)); \
+ "%s: %d: ", __FILE__, __LINE__); \
+ if (PL_numeric_standard <= 1) \
+ PerlIO_printf(Perl_debug_log, \
+ "lc_numeric_standard now unlocked\n");\
+ else PerlIO_printf(Perl_debug_log, \
+ "lc_numeric_standard lock decremented to depth %d\n", \
+ PL_numeric_standard););\
} STMT_END
# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \
#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"
+# include "sv_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
/*
-=for apidoc_section Numeric Functions
+=for apidoc_section $numeric
=for apidoc AmTR|NV|Strtod|NN const char * const s|NULLOK char ** e
#endif
#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \
- (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64)
+ (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64)
# ifdef __hpux
# define strtoll __strtoll /* secret handshake */
# endif
* (as is done for Atoul(), see below) but for backward compatibility
* we just assume atol(). */
# if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && defined(HAS_ATOLL) && \
- (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64)
+ (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64)
# ifdef WIN64
# define atoll _atoi64 /* secret handshake */
# endif
#endif
#if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && \
- (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64)
+ (QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64)
# ifdef __hpux
# define strtoull __strtoull /* secret handshake */
# endif
# include <sys/sem.h>
# ifndef HAS_UNION_SEMUN /* Provide the union semun. */
union semun {
- int val;
- struct semid_ds *buf;
- unsigned short *array;
+ int val;
+ struct semid_ds *buf;
+ unsigned short *array;
};
# endif
# ifdef USE_SEMCTL_SEMUN
# ifdef IRIX32_SEMUN_BROKEN_BY_GCC
union gccbug_semun {
- int val;
- struct semid_ds *buf;
- unsigned short *array;
- char __dummy[5];
- };
+ int val;
+ struct semid_ds *buf;
+ unsigned short *array;
+ char __dummy[5];
+ };
# define semun gccbug_semun
# endif
# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
* access MY_CXT.
*/
-#if defined(PERL_IMPLICIT_CONTEXT)
+#if defined(MULTIPLICITY)
/* 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
* (We allocate my_cxtp in a Perl SV so that it will be released when
* the interpreter goes away.) */
# define MY_CXT_INIT \
- my_cxt_t *my_cxtp = \
- (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \
- PERL_UNUSED_VAR(my_cxtp)
+ my_cxt_t *my_cxtp = \
+ (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \
+ PERL_UNUSED_VAR(my_cxtp)
# define MY_CXT_INIT_INTERP(my_perl) \
- my_cxt_t *my_cxtp = \
- (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \
- PERL_UNUSED_VAR(my_cxtp)
+ my_cxt_t *my_cxtp = \
+ (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_INIT_ARG, sizeof(my_cxt_t)); \
+ PERL_UNUSED_VAR(my_cxtp)
/* This declaration should be used within all functions that use the
* interpreter-local data. */
# define dMY_CXT \
- my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[MY_CXT_INDEX]
+ my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[MY_CXT_INDEX]
# define dMY_CXT_INTERP(my_perl) \
- my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[MY_CXT_INDEX]
+ my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[MY_CXT_INDEX]
/* Clones the per-interpreter data. */
# define MY_CXT_CLONE \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- void * old_my_cxtp = PL_my_cxt_list[MY_CXT_INDEX]; \
- PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp; \
- Copy(old_my_cxtp, my_cxtp, 1, my_cxt_t);
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ void * old_my_cxtp = PL_my_cxt_list[MY_CXT_INDEX]; \
+ PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp; \
+ Copy(old_my_cxtp, my_cxtp, 1, my_cxt_t);
# define aMY_CXT_ aMY_CXT,
# define _aMY_CXT ,aMY_CXT
-#else /* PERL_IMPLICIT_CONTEXT */
-
+#else /* MULTIPLICITY */
# define START_MY_CXT static my_cxt_t my_cxt;
-# define dMY_CXT_SV dNOOP
# define dMY_CXT dNOOP
# define dMY_CXT_INTERP(my_perl) dNOOP
# define MY_CXT_INIT NOOP
# define aMY_CXT_
# define _aMY_CXT
-#endif /* !defined(PERL_IMPLICIT_CONTEXT) */
+#endif /* !defined(MULTIPLICITY) */
#ifdef I_FCNTL
# include <fcntl.h>
#endif
#define IS_NUMBER_IN_UV 0x01 /* number within UV range (maybe not
- int). value returned in pointed-
- to UV */
+ int). value returned in pointed-
+ to UV */
#define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */
#define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation or infnan */
#define IS_NUMBER_NEG 0x08 /* leading minus sign */
#define IS_NUMBER_TRAILING 0x40 /* number has trailing trash */
/*
-=for apidoc_section Numeric Functions
+=for apidoc_section $numeric
=for apidoc AmdR|bool|GROK_NUMERIC_RADIX|NN const char **sp|NN const char *send
#endif
/* ISO 6429 NEL - C1 control NExt Line */
-/* See https://www.unicode.org/unicode/reports/tr13/ */
+/* See https://www.unicode.org/reports/tr13/ */
#define NEXT_LINE_CHAR NEXT_LINE_NATIVE
#ifndef PIPESOCK_MODE
#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
#define PERL_UNICODE_UTF8CACHEASSERT_FLAG 0x0100
#define PERL_UNICODE_STD_FLAG \
- (PERL_UNICODE_STDIN_FLAG | \
- PERL_UNICODE_STDOUT_FLAG | \
- PERL_UNICODE_STDERR_FLAG)
+ (PERL_UNICODE_STDIN_FLAG | \
+ PERL_UNICODE_STDOUT_FLAG | \
+ PERL_UNICODE_STDERR_FLAG)
#define PERL_UNICODE_INOUT_FLAG \
- (PERL_UNICODE_IN_FLAG | \
- PERL_UNICODE_OUT_FLAG)
+ (PERL_UNICODE_IN_FLAG | \
+ PERL_UNICODE_OUT_FLAG)
#define PERL_UNICODE_DEFAULT_FLAGS \
- (PERL_UNICODE_STD_FLAG | \
- PERL_UNICODE_INOUT_FLAG | \
- PERL_UNICODE_LOCALE_FLAG)
+ (PERL_UNICODE_STD_FLAG | \
+ PERL_UNICODE_INOUT_FLAG | \
+ PERL_UNICODE_LOCALE_FLAG)
#define PERL_UNICODE_ALL_FLAGS 0x01ff
#define PERL_UNICODE_WIDESYSCALLS 'W'
#define PERL_UNICODE_UTF8CACHEASSERT 'a'
+#endif
+
/*
-=for apidoc_section Signals
+=for apidoc_section $signals
=for apidoc Amn|U32|PERL_SIGNALS_UNSAFE_FLAG
If this bit in C<PL_signals> is set, the system is uing the pre-Perl 5.8
unsafe signals. See L<perlrun/PERL_SIGNALS> and L<perlipc/Deferred Signals
#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
/*
-=for apidoc_section Numeric Functions
+=for apidoc_section $numeric
-=for apidoc Am|int|PERL_ABS|int
+=for apidoc Am|int|PERL_ABS|int x
Typeless C<abs> or C<fabs>, I<etc>. (The usage below indicates it is for
integers, but it works for any type.) Use instead of these, since the C
#endif
#define do_open(g, n, l, a, rm, rp, sf) \
- do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0)
+ do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0)
#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
# define do_exec(cmd) do_exec3(cmd,0,0)
#endif
/*
-=for apidoc_section Utility Functions
+=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
#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
#define PERL_PV_ESCAPE_RE 0x008000
+/* Escape PV with hex, except leave NULs as octal: */
#define PERL_PV_ESCAPE_DWIM 0x010000
+/* Escape PV with all hex, including NUL. */
+#define PERL_PV_ESCAPE_DWIM_ALL_HEX 0x020000
+
/* used by pv_display in dump.c*/
#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
#else
+/* The declarations here need to match the initializations done above,
+ since a mismatch across compilation units causes undefined
+ behavior. It also prevents warnings from LTO builds.
+*/
+# if !defined(USE_QUADMATH) && \
+ (NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES) || \
+ NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES))
+INFNAN_U8_NV_DECL PL_inf;
+# else
INFNAN_NV_U8_DECL PL_inf;
+# endif
+
+# if !defined(USE_QUADMATH) && \
+ (NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES) || \
+ NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES))
+INFNAN_U8_NV_DECL PL_nan;
+# else
INFNAN_NV_U8_DECL PL_nan;
+# endif
#endif
https://perl5.git.perl.org / perl5.git / blobdiff