/* <--- here ends the logic shared by perl.h and makedef.pl */
-/* Microsoft Visual C++ 6.0 needs special treatment in numerous places */
-#if defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1200 && _MSC_VER < 1300
-# define USING_MSVC6
-#endif
-
#undef START_EXTERN_C
#undef END_EXTERN_C
#undef EXTERN_C
Perl_pregfree(aTHX_ (prog))
#define CALLREGFREE_PVT(prog) \
- if(prog) RX_ENGINE(prog)->rxfree(aTHX_ (prog))
+ if(prog && RX_ENGINE(prog)) RX_ENGINE(prog)->rxfree(aTHX_ (prog))
#define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \
RX_ENGINE(rx)->numbered_buff_FETCH(aTHX_ (rx),(paren),(usesv))
: (REGEXP *)NULL)
#endif
+/* In case Configure was not used (we are using a "canned config"
+ * such as Win32, or a cross-compilation setup, for example) try going
+ * by the gcc major and minor versions. One useful URL is
+ * http://www.ohse.de/uwe/articles/gcc-attributes.html,
+ * but contrary to this information warn_unused_result seems
+ * not to be in gcc 3.3.5, at least. --jhi
+ * Also, when building extensions with an installed perl, this allows
+ * the user to upgrade gcc and get the right attributes, rather than
+ * relying on the list generated at Configure time. --AD
+ * Set these up now otherwise we get confused when some of the <*thread.h>
+ * includes below indirectly pull in <perlio.h> (which needs to know if we
+ * have HASATTRIBUTE_FORMAT).
+ */
+#ifndef PERL_MICRO
+#if defined __GNUC__ && !defined(__INTEL_COMPILER)
+# if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */
+# define HASATTRIBUTE_DEPRECATED
+# endif
+# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
+# define HASATTRIBUTE_FORMAT
+# if defined __MINGW32__
+# define PRINTF_FORMAT_NULL_OK
+# endif
+# endif
+# if __GNUC__ >= 3 /* 3.0 -> */
+# define HASATTRIBUTE_MALLOC
+# endif
+# if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */
+# define HASATTRIBUTE_NONNULL
+# endif
+# if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */
+# define HASATTRIBUTE_NORETURN
+# endif
+# if __GNUC__ >= 3 /* gcc 3.0 -> */
+# define HASATTRIBUTE_PURE
+# endif
+# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
+# define HASATTRIBUTE_UNUSED
+# endif
+# if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus)
+# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */
+# endif
+# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
+# define HASATTRIBUTE_WARN_UNUSED_RESULT
+# endif
+#endif
+#endif /* #ifndef PERL_MICRO */
+
+#ifdef HASATTRIBUTE_DEPRECATED
+# define __attribute__deprecated__ __attribute__((deprecated))
+#endif
+#ifdef HASATTRIBUTE_FORMAT
+# define __attribute__format__(x,y,z) __attribute__((format(x,y,z)))
+#endif
+#ifdef HASATTRIBUTE_MALLOC
+# define __attribute__malloc__ __attribute__((__malloc__))
+#endif
+#ifdef HASATTRIBUTE_NONNULL
+# define __attribute__nonnull__(a) __attribute__((nonnull(a)))
+#endif
+#ifdef HASATTRIBUTE_NORETURN
+# define __attribute__noreturn__ __attribute__((noreturn))
+#endif
+#ifdef HASATTRIBUTE_PURE
+# define __attribute__pure__ __attribute__((pure))
+#endif
+#ifdef HASATTRIBUTE_UNUSED
+# define __attribute__unused__ __attribute__((unused))
+#endif
+#ifdef HASATTRIBUTE_WARN_UNUSED_RESULT
+# define __attribute__warn_unused_result__ __attribute__((warn_unused_result))
+#endif
+/* If we haven't defined the attributes yet, define them to blank. */
+#ifndef __attribute__deprecated__
+# define __attribute__deprecated__
+#endif
+#ifndef __attribute__format__
+# define __attribute__format__(x,y,z)
+#endif
+#ifndef __attribute__malloc__
+# define __attribute__malloc__
+#endif
+#ifndef __attribute__nonnull__
+# define __attribute__nonnull__(a)
+#endif
+#ifndef __attribute__noreturn__
+# define __attribute__noreturn__
+#endif
+#ifndef __attribute__pure__
+# define __attribute__pure__
+#endif
+#ifndef __attribute__unused__
+# define __attribute__unused__
+#endif
+#ifndef __attribute__warn_unused_result__
+# define __attribute__warn_unused_result__
+#endif
+/* Some OS warn on NULL format to printf */
+#ifdef PRINTF_FORMAT_NULL_OK
+# define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z)
+#else
+# define __attribute__format__null_ok__(x,y,z)
+#endif
/*
* Because of backward compatibility reasons the PERL_UNUSED_DECL
*
*/
-#if defined(__SYMBIAN32__) && defined(__GNUC__)
-# ifdef __cplusplus
-# define PERL_UNUSED_DECL
-# else
-# define PERL_UNUSED_DECL __attribute__((unused))
-# endif
-#endif
-
#ifndef PERL_UNUSED_DECL
-# if defined(HASATTRIBUTE_UNUSED) && (!defined(__cplusplus) || __GNUC__ >= 4)
-# define PERL_UNUSED_DECL __attribute__unused__
-# else
-# define PERL_UNUSED_DECL
-# endif
+# define PERL_UNUSED_DECL __attribute__unused__
#endif
/* gcc -Wall:
# 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.
*
#define CLANG_DIAG_IGNORE_STMT(x) CLANG_DIAG_IGNORE(x) NOOP
#define CLANG_DIAG_RESTORE_STMT CLANG_DIAG_RESTORE NOOP
+#if defined(_MSC_VER) && (_MSC_VER >= 1300)
+# define MSVC_DIAG_IGNORE(x) __pragma(warning(push)) \
+ __pragma(warning(disable : x))
+# define MSVC_DIAG_RESTORE __pragma(warning(pop))
+#else
+# define MSVC_DIAG_IGNORE(x)
+# define MSVC_DIAG_RESTORE
+#endif
+#define MSVC_DIAG_IGNORE_DECL(x) MSVC_DIAG_IGNORE(x) dNOOP
+#define MSVC_DIAG_RESTORE_DECL MSVC_DIAG_RESTORE dNOOP
+#define MSVC_DIAG_IGNORE_STMT(x) MSVC_DIAG_IGNORE(x) NOOP
+#define MSVC_DIAG_RESTORE_STMT MSVC_DIAG_RESTORE NOOP
+
#define NOOP /*EMPTY*/(void)0
#define dNOOP struct Perl___notused_struct
#endif
/*
- * STMT_START { statements; } STMT_END;
- * can be used as a single statement, as in
- * if (x) STMT_START { ... } STMT_END; else ...
- *
- * Trying to select a version that gives no warnings...
- */
+=head1 Miscellaneous Functions
+
+=for apidoc AmnUu|void|STMT_START
+
+ STMT_START { statements; } STMT_END;
+
+can be used as a single statement, as in
+
+ if (x) STMT_START { ... } STMT_END; else ...
+
+These are often used in macro definitions. Note that you can't return a value
+out of them.
+
+=for apidoc AmnUhu|void|STMT_END
+
+=cut
+
+ Trying to select a version that gives no warnings...
+*/
#if !(defined(STMT_START) && defined(STMT_END))
# ifdef PERL_USE_GCC_BRACE_GROUPS
# define STMT_START (void)( /* gcc supports "({ STATEMENTS; })" */
# define BYTEORDER 0x1234
#endif
-/* Overall memory policy? */
-#ifndef CONSERVATIVE
-# define LIBERAL 1
-#endif
-
#if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90
#define ASCIIish
#else
# define TAINT_WARN_get 0
# define TAINT_WARN_set(s) NOOP
#else
+ /* Set to tainted if we are running under tainting mode */
# define TAINT (PL_tainted = PL_tainting)
-# define TAINT_NOT (PL_tainted = FALSE)
-# define TAINT_IF(c) if (UNLIKELY(c)) { PL_tainted = PL_tainting; }
+
+# define TAINT_NOT (PL_tainted = FALSE) /* Untaint */
+# define TAINT_IF(c) if (UNLIKELY(c)) { TAINT; } /* Conditionally taint */
# define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); }
-# define TAINT_PROPER(s) if (UNLIKELY(PL_tainting)) { taint_proper(NULL, s); }
+ /* croak or warn if tainting */
+# define TAINT_PROPER(s) if (UNLIKELY(PL_tainting)) { \
+ taint_proper(NULL, s); \
+ }
# define TAINT_set(s) (PL_tainted = (s))
-# define TAINT_get (PL_tainted)
-# define TAINTING_get (PL_tainting)
+# define TAINT_get (cBOOL(UNLIKELY(PL_tainted))) /* Is something tainted? */
+# define TAINTING_get (cBOOL(UNLIKELY(PL_tainting))) /* Is taint checking enabled? */
# define TAINTING_set(s) (PL_tainting = (s))
-# define TAINT_WARN_get (PL_taint_warn)
+# define TAINT_WARN_get (PL_taint_warn) /* FALSE => tainting violations
+ are fatal
+ TRUE => they're just
+ warnings */
# define TAINT_WARN_set(s) (PL_taint_warn = (s))
#endif
#include <sys/types.h>
-/* EVC 4 SDK headers includes a bad definition of MB_CUR_MAX in stdlib.h
- which is included from stdarg.h. Bad definition not present in SD 2008
- SDK headers. wince.h is not yet included, so we cant fix this from there
- since by then MB_CUR_MAX will be defined from stdlib.h.
- cewchar.h includes a correct definition of MB_CUR_MAX and it is copied here
- since cewchar.h can't be included this early */
-#if defined(UNDER_CE) && (_MSC_VER < 1300)
-# define MB_CUR_MAX 1uL
-#endif
-
# include <stdarg.h>
#ifdef I_STDINT
# include <xlocale.h>
#endif
-#if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
-# define USE_LOCALE
+/* If not forbidden, we enable locale handling if either 1) the POSIX 2008
+ * functions are available, or 2) just the setlocale() function. This logic is
+ * repeated in t/loc_tools.pl and makedef.pl; The three should be kept in
+ * sync. */
+#if ! defined(NO_LOCALE)
+
+# if ! defined(NO_POSIX_2008_LOCALE) \
+ && defined(HAS_NEWLOCALE) \
+ && defined(HAS_USELOCALE) \
+ && defined(HAS_DUPLOCALE) \
+ && defined(HAS_FREELOCALE) \
+ && defined(LC_ALL_MASK)
+
+ /* For simplicity, the code is written to assume that any platform advanced
+ * enough to have the Posix 2008 locale functions has LC_ALL. The final
+ * test above makes sure that assumption is valid */
+
+# define HAS_POSIX_2008_LOCALE
+# define USE_LOCALE
+# elif defined(HAS_SETLOCALE)
+# define USE_LOCALE
+# endif
+#endif
+
+#ifdef USE_LOCALE
# define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
- capability */
+ #define */
# if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
&& defined(HAS_STRXFRM)
# define USE_LOCALE_COLLATE
# if !defined(NO_LOCALE_TELEPHONE) && defined(LC_TELEPHONE)
# define USE_LOCALE_TELEPHONE
# endif
-#endif /* !NO_LOCALE && HAS_SETLOCALE */
/* XXX The next few defines are unfortunately duplicated in makedef.pl, and
* changes here MUST also be made there */
-#ifdef USE_LOCALE /* These locale things are all subject to change */
-# if defined(HAS_NEWLOCALE) \
- && defined(LC_ALL_MASK) \
- && defined(HAS_FREELOCALE) \
- && defined(HAS_USELOCALE) \
- && ! defined(NO_POSIX_2008_LOCALE)
-
- /* For simplicity, the code is written to assume that any platform advanced
- * enough to have the Posix 2008 locale functions has LC_ALL. The test
- * above makes sure that assumption is valid */
-
-# define HAS_POSIX_2008_LOCALE
-# endif
-# if defined(USE_ITHREADS) \
- && ( defined(HAS_POSIX_2008_LOCALE) \
- || (defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1400)) \
- && ! defined(NO_THREAD_SAFE_LOCALE)
-# define USE_THREAD_SAFE_LOCALE
+# if ! defined(HAS_SETLOCALE) && defined(HAS_POSIX_2008_LOCALE)
+# define USE_POSIX_2008_LOCALE
+# ifndef USE_THREAD_SAFE_LOCALE
+# define USE_THREAD_SAFE_LOCALE
+# endif
+ /* If compiled with
+ * -DUSE_THREAD_SAFE_LOCALE, will do so even
+ * on unthreaded builds */
+# elif (defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE)) \
+ && ( defined(HAS_POSIX_2008_LOCALE) \
+ || (defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1400)) \
+ && ! defined(NO_THREAD_SAFE_LOCALE)
+# ifndef USE_THREAD_SAFE_LOCALE
+# define USE_THREAD_SAFE_LOCALE
+# endif
# ifdef HAS_POSIX_2008_LOCALE
# define USE_POSIX_2008_LOCALE
# endif
EXTERN_C char *crypt(const char *, const char *);
#endif
+/*
+=head1 Errno
+
+=for apidoc m|void|SETERRNO|int errcode|int vmserrcode
+
+Set C<errno>, and on VMS set C<vaxc$errno>.
+
+=for apidoc mn|void|dSAVEDERRNO
+
+Declare variables needed to save C<errno> and any operating system
+specific error number.
+
+=for apidoc mn|void|dSAVE_ERRNO
+
+Declare variables needed to save C<errno> and any operating system
+specific error number, and save them for optional later restoration
+by C<RESTORE_ERRNO>.
+
+=for apidoc mn|void|SAVE_ERRNO
+
+Save C<errno> and any operating system specific error number for
+optional later restoration by C<RESTORE_ERRNO>. Requires
+C<dSAVEDERRNO> or C<dSAVE_ERRNO> in scope.
+
+=for apidoc mn|void|RESTORE_ERRNO
+
+Restore C<errno> and any operating system specific error number that
+was saved by C<dSAVE_ERRNO> or C<RESTORE_ERRNO>.
+
+=cut
+*/
+
#ifdef SETERRNO
# undef SETERRNO /* SOCKS might have defined this */
#endif
# define RESTORE_ERRNO (errno = saved_errno)
#endif
+/*
+=head1 Warning and Dieing
+
+=for apidoc Amn|SV *|ERRSV
+
+Returns the SV for C<$@>, creating it if needed.
+
+=for apidoc Am|void|CLEAR_ERRSV
+
+Clear the contents of C<$@>, setting it to the empty string.
+
+This replaces any read-only SV with a fresh SV and removes any magic.
+
+=for apidoc Am|void|SANE_ERRSV
+
+Clean up ERRSV so we can safely set it.
+
+This replaces any read-only SV with a fresh writable copy and removes
+any magic.
+
+=cut
+*/
+
#define ERRSV GvSVn(PL_errgv)
/* contains inlined gv_add_by_type */
} \
} STMT_END
+/* contains inlined gv_add_by_type */
+#define SANE_ERRSV() STMT_START { \
+ SV ** const svp = &GvSV(PL_errgv); \
+ if (!*svp) { \
+ *svp = newSVpvs(""); \
+ } else if (SvREADONLY(*svp)) { \
+ SV *dupsv = newSVsv(*svp); \
+ SvREFCNT_dec_NN(*svp); \
+ *svp = dupsv; \
+ } else { \
+ SV *const errsv = *svp; \
+ if (SvMAGICAL(errsv)) { \
+ mg_free(errsv); \
+ } \
+ } \
+ } STMT_END
+
#ifdef PERL_CORE
# define DEFSV (0 + GvSVn(PL_defgv))
#define UNKNOWN_ERRNO_MSG "(unknown)"
-#if VMS
+#ifdef VMS
#define Strerror(e) strerror((e), vaxc$errno)
#else
#define Strerror(e) strerror(e)
/* This used to be conditionally defined based on whether we had a sprintf()
* that correctly returns the string length (as required by C89), but we no
* longer need that. XS modules can (and do) use this name, so it must remain
- * a part of the API that's visible to modules. But we no longer document it
- * either (because using sprintf() rather than snprintf() is almost always
- * a bad idea). */
+ * a part of the API that's visible to modules.
+
+=head1 Miscellaneous Functions
+
+=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
+my_snprintf()
+
+=cut
+*/
#define my_sprintf sprintf
/*
#ifdef HAS_STRLCAT
# define my_strlcat strlcat
-#else
-# define my_strlcat Perl_my_strlcat
#endif
#if defined(PERL_CORE) || defined(PERL_EXT)
#ifdef HAS_STRLCPY
# define my_strlcpy strlcpy
-#else
-# define my_strlcpy Perl_my_strlcpy
#endif
#ifdef HAS_STRNLEN
# define my_strnlen strnlen
-#else
-# define my_strnlen Perl_my_strnlen
#endif
/*
# else
# undef IV_IS_QUAD
# undef UV_IS_QUAD
-#if !defined(PERL_CORE) || defined(USING_MSVC6)
+#if !defined(PERL_CORE)
/* We think that removing this decade-old undef this will cause too much
breakage on CPAN for too little gain. (See RT #119753)
- However, we do need HAS_QUAD in the core for use by the drand48 code,
- but not for Win32 VC6 because it has poor __int64 support. */
+ However, we do need HAS_QUAD in the core for use by the drand48 code. */
# undef HAS_QUAD
#endif
# endif
# include <ieeefp.h>
#endif
-#ifdef USING_MSVC6
-/* VC6 has broken NaN semantics: NaN == NaN returns true instead of false,
- * and for example NaN < IV_MIN. */
-# define NAN_COMPARE_BROKEN
-#endif
#if defined(__DECC) && defined(__osf__)
/* Also Tru64 cc has broken NaN comparisons. */
# define NAN_COMPARE_BROKEN
#endif
/* Win32: _fpclass(), _isnan(), _finite(). */
-#ifdef WIN32
+#ifdef _MSC_VER
# ifndef Perl_isnan
# define Perl_isnan(x) _isnan(x)
# endif
(Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x))
#endif
-#ifdef UNDER_CE
-int isnan(double d);
-#endif
-
#ifndef Perl_isnan
# ifdef Perl_fp_class_nan
# define Perl_isnan(x) Perl_fp_class_nan(x)
# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
#endif
+/*
+=head1 Numeric functions
+
+=for apidoc AmnUh||PERL_INT_MIN
+=for apidoc AmnUh||PERL_LONG_MAX
+=for apidoc AmnUh||PERL_LONG_MIN
+=for apidoc AmnUh||PERL_QUAD_MAX
+=for apidoc AmnUh||PERL_SHORT_MAX
+=for apidoc AmnUh||PERL_SHORT_MIN
+=for apidoc AmnUh||PERL_UCHAR_MAX
+=for apidoc AmnUh||PERL_UCHAR_MIN
+=for apidoc AmnUh||PERL_UINT_MAX
+=for apidoc AmnUh||PERL_ULONG_MAX
+=for apidoc AmnUh||PERL_ULONG_MIN
+=for apidoc AmnUh||PERL_UQUAD_MAX
+=for apidoc AmnUh||PERL_UQUAD_MIN
+=for apidoc AmnUh||PERL_USHORT_MAX
+=for apidoc AmnUh||PERL_USHORT_MIN
+=for apidoc AmnUh||PERL_QUAD_MIN
+=for apidoc AmnU||PERL_INT_MAX
+This and
+C<PERL_INT_MIN>,
+C<PERL_LONG_MAX>,
+C<PERL_LONG_MIN>,
+C<PERL_QUAD_MAX>,
+C<PERL_SHORT_MAX>,
+C<PERL_SHORT_MIN>,
+C<PERL_UCHAR_MAX>,
+C<PERL_UCHAR_MIN>,
+C<PERL_UINT_MAX>,
+C<PERL_ULONG_MAX>,
+C<PERL_ULONG_MIN>,
+C<PERL_UQUAD_MAX>,
+C<PERL_UQUAD_MIN>,
+C<PERL_USHORT_MAX>,
+C<PERL_USHORT_MIN>,
+C<PERL_QUAD_MIN>
+give the largest and smallest number representable in the current
+platform in variables of the corresponding types.
+
+For signed types, the smallest representable number is the most negative
+number, the one furthest away from zero.
+
+For C99 and later compilers, these correspond to things like C<INT_MAX>, which
+are available to the C code. But these constants, furnished by Perl,
+allow code compiled on earlier compilers to portably have access to the same
+constants.
+
+=cut
+
+*/
+
typedef MEM_SIZE STRLEN;
typedef struct op OP;
# define USE_ENVIRON_ARRAY
#endif
+
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+ /* having sigaction(2) means that the OS supports both 1-arg and 3-arg
+ * signal handlers. But the perl core itself only fully supports 1-arg
+ * handlers, so don't enable for now.
+ * NB: POSIX::sigaction() supports both.
+ *
+ * # define PERL_USE_3ARG_SIGHANDLER
+ */
+#endif
+
+/* Siginfo_t:
+ * This is an alias for the OS's siginfo_t, except that where the OS
+ * doesn't support it, declare a dummy version instead. This allows us to
+ * have signal handler functions which always have a Siginfo_t parameter
+ * regardless of platform, (and which will just be passed a NULL value
+ * where the OS doesn't support HAS_SIGACTION).
+ */
+
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+ typedef siginfo_t Siginfo_t;
+#else
+ typedef struct {
+ int si_signo;
+ } Siginfo_t;
+#endif
+
+
/*
* initialise to avoid floating-point exceptions from overflow, etc
*/
# endif
#endif
-/* In case Configure was not used (we are using a "canned config"
- * such as Win32, or a cross-compilation setup, for example) try going
- * by the gcc major and minor versions. One useful URL is
- * http://www.ohse.de/uwe/articles/gcc-attributes.html,
- * but contrary to this information warn_unused_result seems
- * not to be in gcc 3.3.5, at least. --jhi
- * Also, when building extensions with an installed perl, this allows
- * the user to upgrade gcc and get the right attributes, rather than
- * relying on the list generated at Configure time. --AD
- * Set these up now otherwise we get confused when some of the <*thread.h>
- * includes below indirectly pull in <perlio.h> (which needs to know if we
- * have HASATTRIBUTE_FORMAT).
- */
-
-#ifndef PERL_MICRO
-#if defined __GNUC__ && !defined(__INTEL_COMPILER)
-# if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */
-# define HASATTRIBUTE_DEPRECATED
-# endif
-# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
-# define HASATTRIBUTE_FORMAT
-# if defined __MINGW32__
-# define PRINTF_FORMAT_NULL_OK
-# endif
-# endif
-# if __GNUC__ >= 3 /* 3.0 -> */
-# define HASATTRIBUTE_MALLOC
-# endif
-# if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */
-# define HASATTRIBUTE_NONNULL
-# endif
-# if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */
-# define HASATTRIBUTE_NORETURN
-# endif
-# if __GNUC__ >= 3 /* gcc 3.0 -> */
-# define HASATTRIBUTE_PURE
-# endif
-# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
-# define HASATTRIBUTE_UNUSED
-# endif
-# if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus)
-# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */
-# endif
-# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
-# define HASATTRIBUTE_WARN_UNUSED_RESULT
-# endif
-#endif
-#endif /* #ifndef PERL_MICRO */
-
/* USE_5005THREADS needs to be after unixish.h as <pthread.h> includes
* <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
* this results in many functions being undeclared which bothers C++
#define HEKfARG(p) ((void*)(p))
-/* Takes three arguments: is_utf8, length, str */
+/*
+=for apidoc Amnh||UTF8f
+=for apidoc Amh||UTF8fARG|bool is_utf8|Size_t byte_len|char *str
+
+=cut
+ * %4p is a custom format
+ */
#ifndef UTF8f
# define UTF8f "d%" UVuf "%4p"
#endif
# define UVf UVuf
#endif
-#ifdef HASATTRIBUTE_DEPRECATED
-# define __attribute__deprecated__ __attribute__((deprecated))
-#endif
-#ifdef HASATTRIBUTE_FORMAT
-# define __attribute__format__(x,y,z) __attribute__((format(x,y,z)))
-#endif
-#ifdef HASATTRIBUTE_MALLOC
-# define __attribute__malloc__ __attribute__((__malloc__))
-#endif
-#ifdef HASATTRIBUTE_NONNULL
-# define __attribute__nonnull__(a) __attribute__((nonnull(a)))
-#endif
-#ifdef HASATTRIBUTE_NORETURN
-# define __attribute__noreturn__ __attribute__((noreturn))
-#endif
-#ifdef HASATTRIBUTE_PURE
-# define __attribute__pure__ __attribute__((pure))
-#endif
-#ifdef HASATTRIBUTE_UNUSED
-# define __attribute__unused__ __attribute__((unused))
-#endif
-#ifdef HASATTRIBUTE_WARN_UNUSED_RESULT
-# define __attribute__warn_unused_result__ __attribute__((warn_unused_result))
-#endif
-
-/* If we haven't defined the attributes yet, define them to blank. */
-#ifndef __attribute__deprecated__
-# define __attribute__deprecated__
-#endif
-#ifndef __attribute__format__
-# define __attribute__format__(x,y,z)
-#endif
-#ifndef __attribute__malloc__
-# define __attribute__malloc__
-#endif
-#ifndef __attribute__nonnull__
-# define __attribute__nonnull__(a)
-#endif
-#ifndef __attribute__noreturn__
-# define __attribute__noreturn__
-#endif
-#ifndef __attribute__pure__
-# define __attribute__pure__
-#endif
-#ifndef __attribute__unused__
-# define __attribute__unused__
-#endif
-#ifndef __attribute__warn_unused_result__
-# define __attribute__warn_unused_result__
-#endif
-
#if !defined(DEBUGGING) && !defined(NDEBUG)
# define NDEBUG 1
#endif
# define NORETURN_FUNCTION_END NOT_REACHED; return 0
#endif
-/* Some OS warn on NULL format to printf */
-#ifdef PRINTF_FORMAT_NULL_OK
-# define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z)
-#else
-# define __attribute__format__null_ok__(x,y,z)
-#endif
-
#ifdef HAS_BUILTIN_EXPECT
# define EXPECT(expr,val) __builtin_expect(expr,val)
#else
# define EXPECT(expr,val) (expr)
#endif
+
+/*
+=head1 Miscellaneous Functions
+
+=for apidoc AmU|bool|LIKELY|const bool expr
+
+Returns the input unchanged, but at the same time it gives a branch prediction
+hint to the compiler that this condition is likely to be true.
+
+=for apidoc AmU|bool|UNLIKELY|const bool expr
+
+Returns the input unchanged, but at the same time it gives a branch prediction
+hint to the compiler that this condition is likely to be false.
+
+=cut
+*/
#define LIKELY(cond) EXPECT(cBOOL(cond),TRUE)
#define UNLIKELY(cond) EXPECT(cBOOL(cond),FALSE)
+
#ifdef HAS_BUILTIN_CHOOSE_EXPR
/* placeholder */
#endif
STATIC_ASSERT_STMT expands to a statement and is suitable for use inside a
function.
*/
-#if (defined(static_assert) || (defined(__cplusplus) && __cplusplus >= 201103L)) && (!defined(__IBMC__) || __IBMC__ >= 1210)
-/* static_assert is a macro defined in <assert.h> in C11 or a compiler
+#if (! defined(__IBMC__) || __IBMC__ >= 1210) \
+ && (( defined(static_assert) && ( defined(_ISOC11_SOURCE) \
+ || (__STDC_VERSION__ - 0) >= 201101L)) \
+ || (defined(__cplusplus) && __cplusplus >= 201103L))
+/* XXX static_assert is a macro defined in <assert.h> in C11 or a compiler
builtin in C++11. But IBM XL C V11 does not support _Static_assert, no
matter what <assert.h> says.
*/
# define NOT_REACHED
#elif defined(DEBUGGING) && (__has_builtin(__builtin_unreachable) \
|| (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4)) /* 4.5 -> */
-# define NOT_REACHED STMT_START { ASSUME(0); __builtin_unreachable(); } STMT_END
+# define NOT_REACHED STMT_START { ASSUME(!"UNREACHABLE"); __builtin_unreachable(); } STMT_END
#else
-# define NOT_REACHED ASSUME(0)
+# define NOT_REACHED ASSUME(!"UNREACHABLE")
#endif
/* Some unistd.h's give a prototype for pause() even though
/* macros to define bit-fields in structs. */
#ifndef PERL_BITFIELD8
-# define PERL_BITFIELD8 unsigned
+# define PERL_BITFIELD8 U8
#endif
#ifndef PERL_BITFIELD16
-# define PERL_BITFIELD16 unsigned
+# define PERL_BITFIELD16 U16
#endif
#ifndef PERL_BITFIELD32
-# define PERL_BITFIELD32 unsigned
+# define PERL_BITFIELD32 U32
#endif
#include "sv.h"
struct scan_data_t;
typedef struct regnode_charclass regnode_charclass;
-struct regnode_charclass_class;
-
/* A hopefully less confusing name. The sub-classes are all Posix classes only
* used under /l matching */
-typedef struct regnode_charclass_class regnode_charclass_posixl;
+typedef struct regnode_charclass_posixl regnode_charclass_class;
+typedef struct regnode_charclass_posixl regnode_charclass_posixl;
typedef struct regnode_ssc regnode_ssc;
typedef struct RExC_state_t RExC_state_t;
#endif
#ifndef __cplusplus
-#if !(defined(WIN32) || defined(UNDER_CE) || defined(SYMBIAN))
+#if !(defined(WIN32) || defined(SYMBIAN))
Uid_t getuid (void);
Uid_t geteuid (void);
Gid_t getgid (void);
#define DEBUG_B_FLAG 0x02000000 /*33554432*/
#define DEBUG_L_FLAG 0x04000000 /*67108864*/
#define DEBUG_i_FLAG 0x08000000 /*134217728*/
-#define DEBUG_MASK 0x0FFFEFFF /* mask of all the standard flags */
+#define DEBUG_y_FLAG 0x10000000 /*268435456*/
+#define DEBUG_MASK 0x1FFFEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* -D was given --> PL_debug |= FLAG */
# define DEBUG_B_TEST_ UNLIKELY(PL_debug & DEBUG_B_FLAG)
# define DEBUG_L_TEST_ UNLIKELY(PL_debug & DEBUG_L_FLAG)
# define DEBUG_i_TEST_ UNLIKELY(PL_debug & DEBUG_i_FLAG)
+# define DEBUG_y_TEST_ UNLIKELY(PL_debug & DEBUG_y_FLAG)
# define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Lv_TEST_ (DEBUG_L_TEST_ && DEBUG_v_TEST_)
+# define DEBUG_yv_TEST_ (DEBUG_y_TEST_ && DEBUG_v_TEST_)
#ifdef DEBUGGING
# define DEBUG_B_TEST DEBUG_B_TEST_
# define DEBUG_L_TEST DEBUG_L_TEST_
# define DEBUG_i_TEST DEBUG_i_TEST_
+# define DEBUG_y_TEST DEBUG_y_TEST_
# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
# define DEBUG_Uv_TEST DEBUG_Uv_TEST_
# define DEBUG_Pv_TEST DEBUG_Pv_TEST_
# define DEBUG_Lv_TEST DEBUG_Lv_TEST_
+# define DEBUG_yv_TEST DEBUG_yv_TEST_
# define PERL_DEB(a) a
# define PERL_DEB2(a,b) a
# define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
-#ifndef PERL_EXT_RE_BUILD
-# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
-#else
-# define DEBUG_r(a) STMT_START {a;} STMT_END
-#endif /* PERL_EXT_RE_BUILD */
+# ifndef PERL_EXT_RE_BUILD
+# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
+# else
+# define DEBUG_r(a) STMT_START {a;} STMT_END
+# endif /* PERL_EXT_RE_BUILD */
# define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
# define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
# define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a)
# define DEBUG_Pv(a) DEBUG__(DEBUG_Pv_TEST, a)
# define DEBUG_Lv(a) DEBUG__(DEBUG_Lv_TEST, a)
+# define DEBUG_yv(a) DEBUG__(DEBUG_yv_TEST, a)
# define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a)
# define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a)
# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a)
# define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a)
# define DEBUG_i(a) DEBUG__(DEBUG_i_TEST, a)
+# define DEBUG_y(a) DEBUG__(DEBUG_y_TEST, a)
-#else /* DEBUGGING */
+#else /* ! DEBUGGING below */
# define DEBUG_p_TEST (0)
# define DEBUG_s_TEST (0)
# define DEBUG_B_TEST (0)
# define DEBUG_L_TEST (0)
# define DEBUG_i_TEST (0)
+# define DEBUG_y_TEST (0)
# define DEBUG_Xv_TEST (0)
# define DEBUG_Uv_TEST (0)
# define DEBUG_Pv_TEST (0)
# define DEBUG_Lv_TEST (0)
+# define DEBUG_yv_TEST (0)
# define PERL_DEB(a)
# define PERL_DEB2(a,b) b
# define DEBUG_B(a)
# define DEBUG_L(a)
# define DEBUG_i(a)
+# define DEBUG_y(a)
# define DEBUG_Xv(a)
# define DEBUG_Uv(a)
# define DEBUG_Pv(a)
# define DEBUG_Lv(a)
+# define DEBUG_yv(a)
#endif /* DEBUGGING */
EXTCONST char PL_no_func[]
INIT("The %s function is unimplemented");
EXTCONST char PL_no_myglob[]
- INIT("\"%s\" %se %s can't be in a package");
+ INIT("\"%s\" %s %s can't be in a package");
EXTCONST char PL_no_localize_ref[]
INIT("Can't localize through a reference");
EXTCONST char PL_memory_wrap[]
INIT("panic: memory wrap");
-
+EXTCONST char PL_extended_cp_format[]
+ INIT("Code point 0x%" UVXf " is not Unicode, requires a Perl extension,"
+ " and so is not portable");
EXTCONST char PL_Yes[]
INIT("1");
EXTCONST char PL_No[]
EXTCONST char PL_hexdigit[]
INIT("0123456789abcdef0123456789ABCDEF");
+EXTCONST STRLEN PL_WARN_ALL
+ INIT(0);
+EXTCONST STRLEN PL_WARN_NONE
+ INIT(0);
+
/* This is constant on most architectures, a global on OS/2 */
#ifndef OS2
EXTCONST char PL_sh_path[]
#ifndef PERL_GLOBAL_STRUCT /* or perlvars.h */
#ifdef DOINIT
-EXT unsigned char PL_fold_locale[] = { /* Unfortunately not EXTCONST. */
+EXT unsigned char PL_fold_locale[256] = { /* 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,
248, 249, 250, 251, 252, 253, 254, 255
};
#else
-EXT unsigned char PL_fold_locale[]; /* Unfortunately not EXTCONST. */
+EXT unsigned char PL_fold_locale[256]; /* Unfortunately not EXTCONST. */
#endif
#endif /* !PERL_GLOBAL_STRUCT */
#ifndef EBCDIC
/* The tables below are adapted from
- * http://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which requires this copyright
+ * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/, which requires this copyright
* notice:
Copyright (c) 2008-2009 Bjoern Hoehrmann <bjoern@hoehrmann.de>
# ifdef DOINIT
# if 0 /* This is the original table given in
- http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ */
+ https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ */
static U8 utf8d_C9[] = {
/* The first part of the table maps bytes to character classes that
* to reduce the size of the transition table and create bitmasks. */
* that can be returned immediately.
*
* The "Implementation details" portion of
- * http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ shows how
+ * https://bjoern.hoehrmann.de/utf-8/decoder/dfa/ shows how
* the first portion of the table maps each possible byte into a character
* class. And that the classes for those bytes which are start bytes have been
* carefully chosen so they serve as well to be used as a shift value to mask
* the other continuations transitions to N1
* N5 Start byte is F0. Continuation bytes 80-8F are illegal (overlong);
* [9AB]F transition to N10; the other continuations to N2.
- * the other continuations transition to N2
* N6 Start byte is F[123]. Continuation bytes [89AB]F transition
* to N10; the other continuations to N2.
* N7 Start byte is F4. Continuation bytes 90-BF are illegal
/* And below is yet another version of the above tables that accepts only UTF-8
* as defined by Corregidum #9. Hence no surrogates nor non-Unicode, but
* it allows non-characters. This is isomorphic to the original table
- * in http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
+ * in https://bjoern.hoehrmann.de/utf-8/decoder/dfa/
*
* The classes are
* 00-7F 0
# define KEYWORD_PLUGIN_MUTEX_LOCK MUTEX_LOCK(&PL_keyword_plugin_mutex)
# define KEYWORD_PLUGIN_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_keyword_plugin_mutex)
# define KEYWORD_PLUGIN_MUTEX_TERM MUTEX_DESTROY(&PL_keyword_plugin_mutex)
+# define USER_PROP_MUTEX_INIT MUTEX_INIT(&PL_user_prop_mutex)
+# define USER_PROP_MUTEX_LOCK MUTEX_LOCK(&PL_user_prop_mutex)
+# define USER_PROP_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_user_prop_mutex)
+# define USER_PROP_MUTEX_TERM MUTEX_DESTROY(&PL_user_prop_mutex)
#else
# define KEYWORD_PLUGIN_MUTEX_INIT NOOP
# define KEYWORD_PLUGIN_MUTEX_LOCK NOOP
# define KEYWORD_PLUGIN_MUTEX_UNLOCK NOOP
# define KEYWORD_PLUGIN_MUTEX_TERM NOOP
+# define USER_PROP_MUTEX_INIT NOOP
+# define USER_PROP_MUTEX_LOCK NOOP
+# define USER_PROP_MUTEX_UNLOCK NOOP
+# define USER_PROP_MUTEX_TERM NOOP
#endif
#ifdef USE_LOCALE /* These locale things are all subject to change */
# define IN_SOME_LOCALE_FORM_COMPILETIME \
cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
+/*
+=head1 Locale-related functions and macros
+
+=for apidoc Amn|bool|IN_LOCALE
+
+Evaluates to TRUE if the plain locale pragma without a parameter (S<C<use
+locale>>) is in effect.
+
+=for apidoc Amn|bool|IN_LOCALE_COMPILETIME
+
+Evaluates to TRUE if, when compiling a perl program (including an C<eval>) if
+the plain locale pragma without a parameter (S<C<use locale>>) is in effect.
+
+=for apidoc Amn|bool|IN_LOCALE_RUNTIME
+
+Evaluates to TRUE if, when executing a perl program (including an C<eval>) if
+the plain locale pragma without a parameter (S<C<use locale>>) is in effect.
+
+=cut
+*/
+
# define IN_LOCALE \
(IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
# define IN_SOME_LOCALE_FORM \
# if defined (PERL_CORE) || defined (PERL_IN_XSUB_RE)
/* This internal macro should be called from places that operate under
- * locale rules. It there is a problem with the current locale that
+ * locale rules. If there is a problem with the current locale that
* hasn't been raised yet, it will output a warning this time. Because
* this will so rarely be true, there is no point to optimize for time;
* instead it makes sense to minimize space used and do all the work in
else { \
PL_lc_numeric_mutex_depth++; \
DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
- "%s: %d: avoided lc_numeric_lock; depth=%d\n", \
+ "%s: %d: avoided lc_numeric_lock; new depth=%d\n", \
__FILE__, __LINE__, PL_lc_numeric_mutex_depth)); \
if (cond_to_panic_if_already_locked) { \
Perl_croak_nocontext("panic: %s: %d: Trying to change" \
else { \
PL_lc_numeric_mutex_depth--; \
DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
- "%s: %d: avoided lc_numeric_unlock; depth=%d\n", \
+ "%s: %d: avoided lc_numeric_unlock; new depth=%d\n",\
__FILE__, __LINE__, PL_lc_numeric_mutex_depth)); \
} \
} STMT_END \
On threaded perls not operating with thread-safe functionality, this macro uses
a mutex to force a critical section. Therefore the matching RESTORE should be
-close by, and guaranteed to be called.
+close by, and guaranteed to be called; see L</WITH_LC_NUMERIC_SET_TO_NEEDED>
+for a more contained way to ensure that.
+
+=for apidoc Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric
+
+Same as L</STORE_LC_NUMERIC_SET_TO_NEEDED> with in_lc_numeric provided
+as the precalculated value of C<IN_LC(LC_NUMERIC)>. It is the caller's
+responsibility to ensure that the status of C<PL_compiling> and C<PL_hints>
+cannot have changed since the precalculation.
=for apidoc Am|void|RESTORE_LC_NUMERIC
...
}
+=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED|block
+
+This macro invokes the supplied statement or block within the context
+of a L</STORE_LC_NUMERIC_SET_TO_NEEDED> .. L</RESTORE_LC_NUMERIC> pair
+if required, so eg:
+
+ WITH_LC_NUMERIC_SET_TO_NEEDED(
+ SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis)
+ );
+
+is equivalent to:
+
+ {
+#ifdef USE_LOCALE_NUMERIC
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+#endif
+ SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis);
+#ifdef USE_LOCALE_NUMERIC
+ RESTORE_LC_NUMERIC();
+#endif
+ }
+
+=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric|block
+
+Same as L</WITH_LC_NUMERIC_SET_TO_NEEDED> with in_lc_numeric provided
+as the precalculated value of C<IN_LC(LC_NUMERIC)>. It is the caller's
+responsibility to ensure that the status of C<PL_compiling> and C<PL_hints>
+cannot have changed since the precalculation.
+
=cut
*/
# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \
void (*_restore_LC_NUMERIC_function)(pTHX) = NULL
-# define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in) \
STMT_START { \
+ bool _in_lc_numeric = (in); \
LC_NUMERIC_LOCK( \
- (IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_UNDERLYING) \
- || _NOT_IN_NUMERIC_STANDARD); \
- if (IN_LC(LC_NUMERIC)) { \
+ ( ( _in_lc_numeric && _NOT_IN_NUMERIC_UNDERLYING) \
+ || (! _in_lc_numeric && _NOT_IN_NUMERIC_STANDARD))); \
+ if (_in_lc_numeric) { \
if (_NOT_IN_NUMERIC_UNDERLYING) { \
Perl_set_numeric_underlying(aTHX); \
_restore_LC_NUMERIC_function \
} \
} STMT_END
+# define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ STORE_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC))
+
# define RESTORE_LC_NUMERIC() \
STMT_START { \
if (_restore_LC_NUMERIC_function) { \
__FILE__, __LINE__, PL_numeric_standard)); \
} STMT_END
+# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \
+ STMT_START { \
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \
+ STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric); \
+ block; \
+ RESTORE_LC_NUMERIC(); \
+ } STMT_END;
+
+# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \
+ WITH_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC), block)
+
#else /* !USE_LOCALE_NUMERIC */
# define SET_NUMERIC_STANDARD()
# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION
# define STORE_LC_NUMERIC_SET_STANDARD()
# define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING()
+# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric)
# define STORE_LC_NUMERIC_SET_TO_NEEDED()
# define RESTORE_LC_NUMERIC()
# define LOCK_LC_NUMERIC_STANDARD()
# define UNLOCK_LC_NUMERIC_STANDARD()
+# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \
+ STMT_START { block; } STMT_END
+# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \
+ STMT_START { block; } STMT_END
#endif /* !USE_LOCALE_NUMERIC */
#define Atof my_atof
-#ifdef USE_QUADMATH
-# define Perl_strtod(s, e) strtoflt128(s, e)
-#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
-# if defined(__MINGW64_VERSION_MAJOR) && defined(HAS_STRTOLD)
- /***********************************************
- We are unable to use strtold because of
- https://sourceforge.net/p/mingw-w64/bugs/711/
- &
- https://sourceforge.net/p/mingw-w64/bugs/725/
-
- but __mingw_strtold is fine.
- ***********************************************/
-# define Perl_strtod(s, e) __mingw_strtold(s, e)
-# elif defined(HAS_STRTOLD)
-# define Perl_strtod(s, e) strtold(s, e)
-# elif defined(HAS_STRTOD)
-# define Perl_strtod(s, e) (NV)strtod(s, e) /* Unavoidable loss. */
-# endif
-#elif defined(HAS_STRTOD)
-# define Perl_strtod(s, e) strtod(s, e)
+/*
+
+=head1 Numeric functions
+
+=for apidoc AmTR|NV|Strtod|NN const char * const s|NULLOK char ** e
+
+This is a synonym for L</my_strtod>.
+
+=for apidoc AmTR|NV|Strtol|NN const char * const s|NULLOK char ** e|int base
+
+Platform and configuration independent C<strtol>. This expands to the
+appropriate C<strotol>-like function based on the platform and F<Configure>
+options>. For example it could expand to C<strtoll> or C<strtoq> instead of
+C<strtol>.
+
+=for apidoc AmTR|NV|Strtoul|NN const char * const s|NULLOK char ** e|int base
+
+Platform and configuration independent C<strtoul>. This expands to the
+appropriate C<strotoul>-like function based on the platform and F<Configure>
+options>. For example it could expand to C<strtoull> or C<strtouq> instead of
+C<strtoul>.
+
+=cut
+
+*/
+
+#define Strtod my_strtod
+
+#if defined(HAS_STRTOD) \
+ || defined(USE_QUADMATH) \
+ || (defined(HAS_STRTOLD) && defined(HAS_LONG_DOUBLE) \
+ && defined(USE_LONG_DOUBLE))
+# define Perl_strtod Strtod
#endif
#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \
# define Atoul(s) Strtoul(s, NULL, 10)
#endif
+#define grok_bin(s,lp,fp,rp) \
+ grok_bin_oct_hex(s, lp, fp, rp, 1, _CC_BINDIGIT, 'b')
+#define grok_oct(s,lp,fp,rp) \
+ (*(fp) |= PERL_SCAN_DISALLOW_PREFIX, \
+ grok_bin_oct_hex(s, lp, fp, rp, 3, _CC_OCTDIGIT, '\0'))
+#define grok_hex(s,lp,fp,rp) \
+ grok_bin_oct_hex(s, lp, fp, rp, 4, _CC_XDIGIT, 'x')
+
#ifndef PERL_SCRIPT_MODE
#define PERL_SCRIPT_MODE "r"
#endif
#endif
#if defined(HAS_FLOCK) && !defined(HAS_FLOCK_PROTO)
-int flock(int fd, int op);
+EXTERN_C int flock(int fd, int op);
#endif
#ifndef O_RDONLY
#define IS_NUMBER_NAN 0x20 /* this is not */
#define IS_NUMBER_TRAILING 0x40 /* number has trailing trash */
+/*
+=head1 Numeric functions
+
+=for apidoc AmdR|bool|GROK_NUMERIC_RADIX|NN const char **sp|NN const char *send
+
+A synonym for L</grok_numeric_radix>
+
+=cut
+*/
#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
-/* Input flags: */
+/* Number scan flags. All are used for input, the ones used for output are so
+ * marked */
#define PERL_SCAN_ALLOW_UNDERSCORES 0x01 /* grok_??? accept _ in numbers */
#define PERL_SCAN_DISALLOW_PREFIX 0x02 /* grok_??? reject 0x in hex etc */
-#define PERL_SCAN_SILENT_ILLDIGIT 0x04 /* grok_??? not warn about illegal digits */
-#define PERL_SCAN_SILENT_NON_PORTABLE 0x08 /* grok_??? not warn about very large
- numbers which are <= UV_MAX */
+
+/* grok_??? input: ignored; output: found overflow */
+#define PERL_SCAN_GREATER_THAN_UV_MAX 0x04
+
+/* grok_??? don't warn about illegal digits. To preserve total backcompat,
+ * this isn't set on output if one is found. Instead, see
+ * PERL_SCAN_NOTIFY_ILLDIGIT. */
+#define PERL_SCAN_SILENT_ILLDIGIT 0x08
+
#define PERL_SCAN_TRAILING 0x10 /* grok_number_flags() allow trailing
and set IS_NUMBER_TRAILING */
-/* Output flags: */
-#define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */
+/* These are considered experimental, so not exposed publicly */
+#if defined(PERL_CORE) || defined(PERL_EXT)
+/* grok_??? don't warn about very large numbers which are <= UV_MAX;
+ * output: found such a number */
+# define PERL_SCAN_SILENT_NON_PORTABLE 0x20
+
+/* If this is set on input, and no illegal digit is found, it will be cleared
+ * on output; otherwise unchanged */
+# define PERL_SCAN_NOTIFY_ILLDIGIT 0x40
+
+/* Don't warn on overflow; output flag still set */
+# define PERL_SCAN_SILENT_OVERFLOW 0x80
+
+/* Forbid a leading underscore, which the other one doesn't */
+# define PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES (0x100|PERL_SCAN_ALLOW_UNDERSCORES)
+#endif
+
/* to let user control profiling */
#ifdef PERL_GPROF_CONTROL
#define PERL_GPROF_MONCONTROL(x)
#endif
-#ifdef UNDER_CE
-#include "wince.h"
-#endif
-
/* ISO 6429 NEL - C1 control NExt Line */
-/* See http://www.unicode.org/unicode/reports/tr13/ */
+/* See https://www.unicode.org/unicode/reports/tr13/ */
#define NEXT_LINE_CHAR NEXT_LINE_NATIVE
#ifndef PIPESOCK_MODE
#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
-/* Use instead of abs() since abs() forces its argument to be an int,
- * but also beware since this evaluates its argument twice, so no x++. */
+/*
+=head1 Numeric functions
+
+=for apidoc Am|int|PERL_ABS|int
+
+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
+library ones force their argument to be what it is expecting, potentially
+leading to disaster. But also beware that this evaluates its argument twice,
+so no C<x++>.
+
+=cut
+*/
+
#define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
#if defined(__DECC) && defined(__osf__)
# define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0)
#endif
-/* check embedded \0 characters in pathnames passed to syscalls,
- but allow one ending \0 */
-#define IS_SAFE_SYSCALL(p, len, what, op_name) (S_is_safe_syscall(aTHX_ (p), (len), (what), (op_name)))
+
+/*
+=head1 Miscellaneous Functions
+
+=for apidoc Am|bool|IS_SAFE_SYSCALL|NN const char *pv|STRLEN len|NN const char *what|NN const char *op_name
+
+Same as L</is_safe_syscall>.
+
+=cut
+
+Allows one ending \0
+*/
+#define IS_SAFE_SYSCALL(p, len, what, op_name) (Perl_is_safe_syscall(aTHX_ (p), (len), (what), (op_name)))
#define IS_SAFE_PATHNAME(p, len, op_name) IS_SAFE_SYSCALL((p), (len), "pathname", (op_name))
*/
/* The quadmath literals are anon structs which -Wc++-compat doesn't like. */
+# ifndef USE_CPLUSPLUS
GCC_DIAG_IGNORE_DECL(-Wc++-compat);
+# endif
# ifdef USE_QUADMATH
/* Cannot use HUGE_VALQ for PL_inf because not a compile-time
# endif
# endif
+# ifndef USE_CPLUSPLUS
GCC_DIAG_RESTORE_DECL;
+# endif
#else