#define USE_STDIO
#endif /* PERL_FOR_X2P */
-#ifdef VOIDUSED
-# undef VOIDUSED
-#endif
-#define VOIDUSED 1
-
#ifdef PERL_MICRO
# include "uconfig.h"
#else
-# ifndef USE_CROSS_COMPILE
-# include "config.h"
-# else
-# include "xconfig.h"
-# endif
+# include "config.h"
+#endif
+
+/* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined
+ * because the __STDC_VERSION__ became a thing only with C90. Therefore,
+ * with gcc, HAS_C99 will never become true as long as we use -std=c89.
+
+ * NOTE 2: headers lie. Do not expect that if HAS_C99 gets to be true,
+ * all the C99 features are there and are correct. */
+#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || \
+ defined(_STDC_C99)
+# define HAS_C99 1
#endif
/* See L<perlguts/"The Perl API"> for detailed notes on
# define USE_HEAP_INSTEAD_OF_STACK
#endif
-#/* Use the reentrant APIs like localtime_r and getpwent_r */
+/* Use the reentrant APIs like localtime_r and getpwent_r */
/* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN)
# define USE_REENTRANT_API
/* <--- here ends the logic shared by perl.h and makedef.pl */
-/*
- * PERL_DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned)
- * (The -DPERL_DARWIN comes from the hints/darwin.sh.)
- * __bsdi__ for BSD/OS
- */
-#if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(PERL_DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44)
-# ifndef BSDish
-# define BSDish
-# endif
+/* 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
# ifdef PERL_GLOBAL_STRUCT_PRIVATE
EXTERN_C struct perl_vars* Perl_GetVarsPrivate();
# define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */
-# ifndef PERLIO_FUNCS_CONST
-# define PERLIO_FUNCS_CONST /* Can't have these lying around. */
-# endif
# else
# define PERL_GET_VARS() PL_VarsPtr
# endif
# endif
#endif
+/* this used to be off by default, now its on, see perlio.h */
+#define PERLIO_FUNCS_CONST
+
#define pVAR struct perl_vars* my_vars PERL_UNUSED_DECL
#ifdef PERL_GLOBAL_STRUCT
# define pTHX_7 8
# define pTHX_8 9
# define pTHX_9 10
+# define pTHX_12 13
# if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL)
# define PERL_TRACK_MEMPOOL
# endif
#endif
#ifndef PERL_UNUSED_DECL
-# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
+# if defined(HASATTRIBUTE_UNUSED) && (!defined(__cplusplus) || (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)))
# define PERL_UNUSED_DECL __attribute__unused__
# else
# define PERL_UNUSED_DECL
/* gcc -Wall:
* for silencing unused variables that are actually used most of the time,
- * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs
+ * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs,
+ * or variables/arguments that are used only in certain configurations.
*/
#ifndef PERL_UNUSED_ARG
# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
# include <note.h>
# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
# else
-# define PERL_UNUSED_ARG(x) ((void)x)
+# define PERL_UNUSED_ARG(x) ((void)sizeof(x))
# endif
#endif
#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(x) ((void)x)
+# define PERL_UNUSED_VAR(x) ((void)sizeof(x))
#endif
-#ifdef USE_ITHREADS
+#if defined(USE_ITHREADS) || defined(PERL_GLOBAL_STRUCT)
# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
#else
# define PERL_UNUSED_CONTEXT
#endif
+/* gcc (-ansi) -pedantic doesn't allow gcc statement expressions,
+ * g++ allows them but seems to have problems with them
+ * (insane errors ensue).
+ * g++ does not give insane errors now (RMB 2008-01-30, gcc 4.2.2).
+ */
+#if defined(PERL_GCC_PEDANTIC) || \
+ (defined(__GNUC__) && defined(__cplusplus) && \
+ ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 2))))
+# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
+#endif
+
+/* Use PERL_UNUSED_RESULT() to suppress the warnings about unused results
+ * of function calls, e.g. PERL_UNUSED_RESULT(foo(a, b)).
+ *
+ * The main reason for this is that the combination of gcc -Wunused-result
+ * (part of -Wall) and the __attribute__((warn_unused_result)) cannot
+ * be silenced with casting to void. This causes trouble when the system
+ * header files use the attribute.
+ *
+ * Use PERL_UNUSED_RESULT sparingly, though, since usually the warning
+ * is there for a good reason: you might lose success/failure information,
+ * or leak resources, or changes in resources.
+ *
+ * But sometimes you just want to ignore the return value, e.g. on
+ * codepaths soon ending up in abort, or in "best effort" attempts,
+ * or in situations where there is no good way to handle failures.
+ *
+ * Sometimes PERL_UNUSED_RESULT might not be the most natural way:
+ * another possibility is that you can capture the return value
+ * and use PERL_UNUSED_VAR on that.
+ *
+ * The __typeof__() is used instead of typeof() since typeof() is not
+ * available under strict C89, and because of compilers masquerading
+ * as gcc (clang and icc), we want exactly the gcc extension
+ * __typeof__ and nothing else.
+ */
+#ifndef PERL_UNUSED_RESULT
+# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
+# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
+# else
+# define PERL_UNUSED_RESULT(v) ((void)(v))
+# endif
+#endif
+
+/* on gcc (and clang), specify that a warning should be temporarily
+ * ignored; e.g.
+ *
+ * GCC_DIAG_IGNORE(-Wmultichar);
+ * char b = 'ab';
+ * GCC_DIAG_RESTORE;
+ *
+ * based on http://dbp-consulting.com/tutorials/SuppressingGCCWarnings.html
+ *
+ * Note that "pragma GCC diagnostic push/pop" was added in GCC 4.6, Mar 2011;
+ * clang only pretends to be GCC 4.2, but still supports push/pop.
+ *
+ * Note on usage: on non-gcc (or lookalike, like clang) compilers
+ * one cannot use these at file (global) level without warnings
+ * since they are defined as empty, which leads into the terminating
+ * semicolon being left alone on a line:
+ * ;
+ * which makes compilers mildly cranky. Therefore at file level one
+ * should use the GCC_DIAG_IGNORE and GCC_DIAG_RESTORE_FILE *without*
+ * the semicolons.
+ *
+ * (A dead-on-arrival solution would be to try to define the macros as
+ * NOOP or dNOOP, those don't work both inside functions and outside.)
+ */
+
+#if defined(__clang__) || defined(__clang) || \
+ (defined( __GNUC__) && ((__GNUC__ * 100) + __GNUC_MINOR__) >= 406)
+# 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") \
+ GCC_DIAG_PRAGMA(GCC diagnostic ignored #x)
+# define GCC_DIAG_RESTORE _Pragma("GCC diagnostic pop")
+#else
+# define GCC_DIAG_IGNORE(w)
+# define GCC_DIAG_RESTORE
+#endif
+
#define NOOP /*EMPTY*/(void)0
/* cea2e8a9dd23747f accidentally lost the comment originally from the first
check in of thread.h, explaining why we need dNOOP at all: */
#endif
#ifndef pTHX
-/* Don't bother defining tTHX and sTHX; using them outside
+/* Don't bother defining tTHX ; using it outside
* code guarded by PERL_IMPLICIT_CONTEXT is an error.
*/
# define pTHX void
# define pTHX_7 7
# define pTHX_8 8
# define pTHX_9 9
+# define pTHX_12 12
#endif
#ifndef dVAR
# endif
#endif
-#ifdef OP_IN_REGISTER
-# ifdef __GNUC__
-# define stringify_immed(s) #s
-# define stringify(s) stringify_immed(s)
-struct op *Perl_op asm(stringify(OP_IN_REGISTER));
-# endif
-#endif
-
-/* gcc (-ansi) -pedantic doesn't allow gcc statement expressions,
- * g++ allows them but seems to have problems with them
- * (insane errors ensue).
- * g++ does not give insane errors now (RMB 2008-01-30, gcc 4.2.2).
- */
-#if defined(PERL_GCC_PEDANTIC) || \
- (defined(__GNUC__) && defined(__cplusplus) && \
- ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 2))))
-# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# endif
-#endif
-
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
# ifndef PERL_USE_GCC_BRACE_GROUPS
# define PERL_USE_GCC_BRACE_GROUPS
# define STMT_START (void)( /* gcc supports "({ STATEMENTS; })" */
# define STMT_END )
# else
- /* Now which other defined()s do we need here ??? */
-# if (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
-# define STMT_START if (1)
-# define STMT_END else (void)0
-# else
# define STMT_START do
# define STMT_END while (0)
-# endif
# endif
#endif
* DANGER! Using NO_TAINT_SUPPORT or SILENT_NO_TAINT_SUPPORT
* voids your nonexistent warranty!
*/
-#if SILENT_NO_TAINT_SUPPORT && !defined(NO_TAINT_SUPPORT)
+#if defined(SILENT_NO_TAINT_SUPPORT) && !defined(NO_TAINT_SUPPORT)
# define NO_TAINT_SUPPORT 1
#endif
* operations into no-ops for a very modest speed-up. Enable only if you
* know what you're doing: tests and CPAN modules' tests are bound to fail.
*/
-#if NO_TAINT_SUPPORT
+#ifdef NO_TAINT_SUPPORT
# define TAINT NOOP
# define TAINT_NOT NOOP
# define TAINT_IF(c) NOOP
# include <pthread.h>
#endif
-#ifndef _TYPES_ /* If types.h defines this it's easy. */
-# ifndef major /* Does everyone's types.h define this? */
-# include <sys/types.h>
-# endif
-#endif
+#include <sys/types.h>
#ifdef __cplusplus
# ifndef I_STDARG
# endif
#endif
+/* EVC 4 SDK headers includes a bad definition of MB_CUR_MAX in stdlib.h
+ which is included from stdarg.h. Bad definition not present in SD 2008
+ SDK headers. wince.h is not yet included, so we cant fix this from there
+ since by then MB_CUR_MAX will be defined from stdlib.h.
+ cewchar.h includes a correct definition of MB_CUR_MAX and it is copied here
+ since cewchar.h can't be included this early */
+#if defined(UNDER_CE) && (_MSC_VER < 1300)
+# define MB_CUR_MAX 1
+#endif
#ifdef I_STDARG
# include <stdarg.h>
#else
# endif
#endif
-#ifdef USE_NEXT_CTYPE
+#ifdef I_STDINT
+# include <stdint.h>
+#endif
-#if NX_CURRENT_COMPILER_RELEASE >= 500
-# include <bsd/ctypes.h>
-#else
-# if NX_CURRENT_COMPILER_RELEASE >= 400
-# include <objc/NXCType.h>
-# else /* NX_CURRENT_COMPILER_RELEASE < 400 */
-# include <appkit/NXCType.h>
-# endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */
-#endif /* NX_CURRENT_COMPILER_RELEASE >= 500 */
-
-#else /* !USE_NEXT_CTYPE */
#include <ctype.h>
-#endif /* USE_NEXT_CTYPE */
#ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */
#undef METHOD
# if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY)
# define USE_LOCALE_MONETARY
# endif
+# if !defined(NO_LOCALE_TIME) && defined(LC_TIME)
+# define USE_LOCALE_TIME
+# endif
+# ifndef WIN32 /* No wrapper except on Windows */
+# define my_setlocale(a,b) setlocale(a,b)
+# endif
#endif /* !NO_LOCALE && HAS_SETLOCALE */
+/* Is $^ENCODING set, or are we under the encoding pragma? */
+#define IN_ENCODING UNLIKELY(PL_encoding \
+ || (PL_lex_encoding && _get_encoding() != NULL))
+
#include <setjmp.h>
#ifdef I_SYS_PARAM
# include <sys/param.h>
#endif
+/* On BSD-derived systems, <sys/param.h> defines BSD to a year-month
+ value something like 199306. This may be useful if no more-specific
+ feature test is available.
+*/
+#if defined(BSD)
+# ifndef BSDish
+# define BSDish
+# endif
+#endif
+
/* Use all the "standard" definitions? */
#if defined(STANDARD_C) && defined(I_STDLIB)
# include <stdlib.h>
# undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */
#endif
-#if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO)
+#if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO)
EXTERN_C int syscall(int, ...);
#endif
-#if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO) && !defined(PERL_MICRO)
+#if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO)
EXTERN_C int usleep(unsigned int);
#endif
# define PERL_STRLEN_EXPAND_SHIFT 2
#endif
-#if defined(STANDARD_C) && defined(I_STDDEF)
+#if defined(STANDARD_C) && defined(I_STDDEF) && !defined(PERL_GCC_PEDANTIC)
# include <stddef.h>
# define STRUCT_OFFSET(s,m) offsetof(s,m)
#else
# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
#endif
+/* ptrdiff_t is C11, so undef it under pedantic builds */
+#ifdef PERL_GCC_PEDANTIC
+# undef HAS_PTRDIFF_T
+#endif
+
#ifndef __SYMBIAN32__
# if defined(I_STRING) || defined(__cplusplus)
# include <string.h>
# define CHECK_MALLOC_TAINT(newval) \
CHECK_MALLOC_TOO_LATE_FOR_( \
if (newval) { \
- panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\
+ 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)) { \
extern int memcmp (char*, char*, int);
# endif
# endif
-# ifdef BUGGY_MSC
-# pragma function(memcmp)
-# endif
#else
# ifndef memcmp
# define memcmp my_memcmp
# include <arpa/inet.h>
#endif
-#if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
-/* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
- * (the neo-BSD seem to do this). */
-# undef SF_APPEND
-#endif
-
#ifdef I_SYS_STAT
# include <sys/stat.h>
#endif
# define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */
#endif
-/* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one.
- * This is important for using IPv6.
- * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be
- * a bad idea since it breaks send() and recv(). */
-#if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X)
-# define _SOCKADDR_LEN
-#endif
-
#if defined(HAS_SOCKET) && !defined(WIN32) /* WIN32 handles sockets via win32.h */
# include <sys/socket.h>
# if defined(USE_SOCKS) && defined(I_SOCKS)
#endif
#if defined(__cplusplus)
-# if defined(__OpenBSD__) || defined(__FreeBSD__) || defined(__NetBSD__)
+# if defined(BSDish)
EXTERN_C char **environ;
# elif defined(__CYGWIN__)
EXTERN_C char *crypt(const char *, const char *);
# define SS_DEVOFFLINE SS$_DEVOFFLINE
# define SS_IVCHAN SS$_IVCHAN
# define SS_NORMAL SS$_NORMAL
+# define SS_NOPRIV SS$_NOPRIV
+# define SS_BUFFEROVF SS$_BUFFEROVF
#else
# define LIB_INVARG 0
# define RMS_DIR 0
# define SS_DEVOFFLINE 0
# define SS_IVCHAN 0
# define SS_NORMAL 0
+# define SS_NOPRIV 0
+# define SS_BUFFEROVF 0
#endif
#ifdef WIN32
#define ERRSV GvSVn(PL_errgv)
+/* contains inlined gv_add_by_type */
#define CLEAR_ERRSV() STMT_START { \
- if (!GvSV(PL_errgv)) { \
- sv_setpvs(GvSV(gv_add_by_type(PL_errgv, SVt_PV)), ""); \
- } else if (SvREADONLY(GvSV(PL_errgv))) { \
- SvREFCNT_dec(GvSV(PL_errgv)); \
- GvSV(PL_errgv) = newSVpvs(""); \
+ SV ** const svp = &GvSV(PL_errgv); \
+ if (!*svp) { \
+ goto clresv_newemptypv; \
+ } else if (SvREADONLY(*svp)) { \
+ SvREFCNT_dec_NN(*svp); \
+ clresv_newemptypv: \
+ *svp = newSVpvs(""); \
} else { \
- SV *const errsv = GvSV(PL_errgv); \
+ SV *const errsv = *svp; \
sv_setpvs(errsv, ""); \
+ SvPOK_only(errsv); \
if (SvMAGICAL(errsv)) { \
mg_free(errsv); \
} \
- SvPOK_only(errsv); \
} \
} STMT_END
# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif
-#define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */
-
#ifndef errno
extern int errno; /* ANSI allows errno to be an lvalue expr.
* For example in multithreaded environments
* #define errno (*_errno()) */
#endif
+#define UNKNOWN_ERRNO_MSG "(unknown)"
+
#ifdef HAS_STRERROR
# ifndef DONT_DECLARE_STD
# ifdef VMS
extern char *sys_errlist[];
# ifndef Strerror
# define Strerror(e) \
- ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
+ ((e) < 0 || (e) >= sys_nerr ? UNKNOWN_ERRNO_MSG : sys_errlist[e])
# endif
# endif
#endif
/* Configure already sets Direntry_t */
#if defined(I_DIRENT)
# include <dirent.h>
- /* NeXT needs dirent + sys/dir.h */
-# if defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__))
-# include <sys/dir.h>
-# endif
#else
# ifdef I_SYS_NDIR
# include <sys/ndir.h>
# endif
#endif
-#ifdef PERL_MICRO
-# ifndef DIR
-# define DIR void
-# endif
-#endif
-
-#ifdef FPUTS_BOTCH
-/* work around botch in SunOS 4.0.1 and 4.0.2 */
-# ifndef fputs
-# define fputs(sv,fp) fprintf(fp,"%s",sv)
-# endif
-#endif
-
/*
* The following gobbledygook brought to you on behalf of __STDC__.
* (I could just use #ifndef __STDC__, but this is more bulletproof
* in the face of half-implementations.)
*/
-#if defined(I_SYSMODE) && !defined(PERL_MICRO)
+#if defined(I_SYSMODE)
#include <sys/mode.h>
#endif
# define S_IEXEC S_IXUSR
#endif
-#ifdef ff_next
-# undef ff_next
-#endif
-
#if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
# define SLOPPYDIVIDE
#endif
* that should be true only if the snprintf()/vsnprintf() are true
* to the standard. */
+#define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len >= (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END
+
+#ifdef USE_QUADMATH
+# define my_snprintf Perl_my_snprintf
+# define PERL_MY_SNPRINTF_GUARDED
+#else
#if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define my_snprintf(buffer, len, ...) ({ int __len__ = snprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: snprintf buffer overflow"); __len__; })
+# define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; })
# define PERL_MY_SNPRINTF_GUARDED
# else
-# define my_snprintf(buffer, len, ...) snprintf(buffer, len, __VA_ARGS__)
+# define my_snprintf(buffer, max, ...) snprintf(buffer, max, __VA_ARGS__)
# endif
#else
# define my_snprintf Perl_my_snprintf
# define PERL_MY_SNPRINTF_GUARDED
#endif
+#endif
+/* There is no quadmath_vsnprintf, and therefore my_vsnprintf()
+ * dies if called under USE_QUADMATH. */
#if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (Size_t)(len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; })
+# define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; })
# define PERL_MY_VSNPRINTF_GUARDED
# else
-# define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__)
+# define my_vsnprintf(buffer, max, ...) vsnprintf(buffer, max, __VA_ARGS__)
# endif
#else
# define my_vsnprintf Perl_my_vsnprintf
# define PERL_MY_VSNPRINTF_GUARDED
#endif
+/* You will definitely need to use the PERL_MY_SNPRINTF_POST_GUARD()
+ * or PERL_MY_VSNPRINTF_POST_GUARD() if you otherwise decide to ignore
+ * the result of my_snprintf() or my_vsnprintf(). (No, you should not
+ * completely ignore it: otherwise you cannot know whether your output
+ * was too long.)
+ *
+ * int len = my_sprintf(buf, max, ...);
+ * PERL_MY_SNPRINTF_POST_GUARD(len, max);
+ *
+ * The trick is that in certain platforms [a] the my_sprintf() already
+ * contains the sanity check, while in certain platforms [b] it needs
+ * to be done as a separate step. The POST_GUARD is that step-- in [a]
+ * platforms the POST_GUARD actually does nothing since the check has
+ * already been done. Watch out for the max being the same in both calls.
+ *
+ * If you actually use the snprintf/vsnprintf return value already,
+ * you assumedly are checking its validity somehow. But you can
+ * insert the POST_GUARD() also in that case. */
+
+#ifndef PERL_MY_SNPRINTF_GUARDED
+# define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, snprintf)
+#else
+# define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len)
+#endif
+
+#ifndef PERL_MY_VSNPRINTF_GUARDED
+# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, vsnprintf)
+#else
+# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len)
+#endif
+
#ifdef HAS_STRLCAT
# define my_strlcat strlcat
#else
# else
# undef IV_IS_QUAD
# undef UV_IS_QUAD
+#if !defined(PERL_CORE) || defined(USING_MSVC6)
+/* 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. */
# undef HAS_QUAD
+#endif
# endif
#endif
-#define SSize_t_MAX (SSize_t)(~(size_t)0 >> 1)
-
-#ifndef HAS_QUAD
-# undef PERL_NEED_MY_HTOLE64
-# undef PERL_NEED_MY_LETOH64
-# undef PERL_NEED_MY_HTOBE64
-# undef PERL_NEED_MY_BETOH64
-#endif
+#define Size_t_MAX (~(Size_t)0)
+#define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1)
#define IV_DIG (BIT_DIGITS(IVSIZE * 8))
#define UV_DIG (BIT_DIGITS(UVSIZE * 8))
#define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */
#ifdef USE_LONG_DOUBLE
-# if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
-# define LONG_DOUBLE_EQUALS_DOUBLE
-# endif
-# if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE))
-# undef USE_LONG_DOUBLE /* Ouch! */
+# if LONG_DOUBLESIZE == DOUBLESIZE
+# define LONG_DOUBLE_EQUALS_DOUBLE
+# undef USE_LONG_DOUBLE /* Ouch! */
# endif
#endif
# 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
+
#ifdef USE_LONG_DOUBLE
# ifdef I_SUNMATH
# include <sunmath.h>
# endif
-# define NV_DIG LDBL_DIG
-# ifdef LDBL_MANT_DIG
-# define NV_MANT_DIG LDBL_MANT_DIG
-# endif
-# ifdef LDBL_MIN
-# define NV_MIN LDBL_MIN
-# endif
-# ifdef LDBL_MAX
-# define NV_MAX LDBL_MAX
-# endif
-# ifdef LDBL_MIN_10_EXP
-# define NV_MIN_10_EXP LDBL_MIN_10_EXP
-# endif
-# ifdef LDBL_MAX_10_EXP
-# define NV_MAX_10_EXP LDBL_MAX_10_EXP
-# endif
-# ifdef LDBL_EPSILON
-# define NV_EPSILON LDBL_EPSILON
-# endif
-# ifdef LDBL_MAX
-# define NV_MAX LDBL_MAX
+# if defined(LDBL_DIG)
+# define NV_DIG LDBL_DIG
+# ifdef LDBL_MANT_DIG
+# define NV_MANT_DIG LDBL_MANT_DIG
+# endif
+# ifdef LDBL_MIN
+# define NV_MIN LDBL_MIN
+# endif
+# ifdef LDBL_MAX
+# define NV_MAX LDBL_MAX
+# endif
+# ifdef LDBL_MIN_EXP
+# define NV_MIN_EXP LDBL_MIN_EXP
+# endif
+# ifdef LDBL_MAX_EXP
+# define NV_MAX_EXP LDBL_MAX_EXP
+# endif
+# ifdef LDBL_MIN_10_EXP
+# define NV_MIN_10_EXP LDBL_MIN_10_EXP
+# endif
+# ifdef LDBL_MAX_10_EXP
+# define NV_MAX_10_EXP LDBL_MAX_10_EXP
+# endif
+# ifdef LDBL_EPSILON
+# define NV_EPSILON LDBL_EPSILON
+# endif
+# ifdef LDBL_MAX
+# define NV_MAX LDBL_MAX
/* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */
-# else
-# ifdef HUGE_VALL
-# define NV_MAX HUGE_VALL
# else
-# ifdef HUGE_VAL
-# define NV_MAX ((NV)HUGE_VAL)
+# ifdef HUGE_VALL
+# define NV_MAX HUGE_VALL
# endif
# endif
# endif
-# ifdef HAS_SQRTL
+# if defined(HAS_SQRTL)
+# define Perl_acos acosl
+# define Perl_asin asinl
+# define Perl_atan atanl
+# define Perl_atan2 atan2l
+# define Perl_ceil ceill
# define Perl_cos cosl
-# define Perl_sin sinl
-# define Perl_sqrt sqrtl
+# define Perl_cosh coshl
# define Perl_exp expl
-# define Perl_log logl
-# define Perl_atan2 atan2l
-# define Perl_pow powl
+/* no Perl_fabs, but there's PERL_ABS */
# define Perl_floor floorl
-# define Perl_ceil ceill
# define Perl_fmod fmodl
+# define Perl_log logl
+# define Perl_log10 log10l
+# define Perl_pow powl
+# define Perl_sin sinl
+# define Perl_sinh sinhl
+# define Perl_sqrt sqrtl
+# define Perl_tan tanl
+# define Perl_tanh tanhl
# endif
/* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
-# ifdef HAS_MODFL
-# define Perl_modf(x,y) modfl(x,y)
+# ifndef Perl_modf
+# ifdef HAS_MODFL
+# define Perl_modf(x,y) modfl(x,y)
/* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no
prototype in <math.h> */
-# ifndef HAS_MODFL_PROTO
+# ifndef HAS_MODFL_PROTO
EXTERN_C long double modfl(long double, long double *);
-# endif
-# else
-# if defined(HAS_AINTL) && defined(HAS_COPYSIGNL)
+# endif
+# elif (defined(HAS_TRUNCL) || defined(HAS_AINTL)) && defined(HAS_COPYSIGNL)
extern long double Perl_my_modfl(long double x, long double *ip);
# define Perl_modf(x,y) Perl_my_modfl(x,y)
# endif
# endif
-# ifdef HAS_FREXPL
-# define Perl_frexp(x,y) frexpl(x,y)
-# else
-# if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
- extern long double Perl_my_frexpl(long double x, int *e);
-# define Perl_frexp(x,y) Perl_my_frexpl(x,y)
+# ifndef Perl_frexp
+# ifdef HAS_FREXPL
+# define Perl_frexp(x,y) frexpl(x,y)
+# else
+# if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
+extern long double Perl_my_frexpl(long double x, int *e);
+# define Perl_frexp(x,y) Perl_my_frexpl(x,y)
+# endif
+# endif
+# endif
+# ifndef Perl_ldexp
+# ifdef HAS_LDEXPL
+# define Perl_ldexp(x, y) ldexpl(x,y)
+# else
+# if defined(HAS_SCALBNL) && FLT_RADIX == 2
+# define Perl_ldexp(x,y) scalbnl(x,y)
+# endif
# endif
# endif
# ifndef Perl_isnan
-# ifdef HAS_ISNANL
+# if defined(HAS_ISNANL) && !(defined(isnan) && defined(HAS_C99))
# define Perl_isnan(x) isnanl(x)
# endif
# endif
# ifndef Perl_isinf
-# ifdef HAS_FINITEL
-# define Perl_isinf(x) !(finitel(x)||Perl_isnan(x))
+# if defined(HAS_ISINFL) && !(defined(isinf) && defined(HAS_C99))
+# define Perl_isinf(x) isinfl(x)
+# elif defined(LDBL_MAX) && !defined(NAN_COMPARE_BROKEN)
+# define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX)
# endif
# endif
+# ifndef Perl_isfinite
+# define Perl_isfinite(x) Perl_isfinitel(x)
+# endif
+#elif defined(USE_QUADMATH) && defined(I_QUADMATH)
+# include <quadmath.h>
+# define NV_DIG FLT128_DIG
+# define NV_MANT_DIG FLT128_MANT_DIG
+# define NV_MIN FLT128_MIN
+# define NV_MAX FLT128_MAX
+# define NV_MIN_EXP FLT128_MIN_EXP
+# define NV_MAX_EXP FLT128_MAX_EXP
+# define NV_EPSILON FLT128_EPSILON
+# define NV_MIN_10_EXP FLT128_MIN_10_EXP
+# define NV_MAX_10_EXP FLT128_MAX_10_EXP
+# define NV_INF HUGE_VALQ
+# define NV_NAN nanq("0")
+# define Perl_acos acosq
+# define Perl_asin asinq
+# define Perl_atan atanq
+# define Perl_atan2 atan2q
+# define Perl_ceil ceilq
+# define Perl_cos cosq
+# define Perl_cosh coshq
+# define Perl_exp expq
+/* no Perl_fabs, but there's PERL_ABS */
+# define Perl_floor floorq
+# define Perl_fmod fmodq
+# define Perl_log logq
+# define Perl_log10 log10q
+# define Perl_pow powq
+# define Perl_sin sinq
+# define Perl_sinh sinhq
+# define Perl_sqrt sqrtq
+# define Perl_tan tanq
+# define Perl_tanh tanhq
+# define Perl_modf(x,y) modfq(x,y)
+# define Perl_frexp(x,y) frexpq(x,y)
+# define Perl_ldexp(x, y) ldexpq(x,y)
+# define Perl_isinf(x) isinfq(x)
+# define Perl_isnan(x) isnanq(x)
+# define Perl_isfinite(x) !(isnanq(x) || isinfq(x))
#else
# define NV_DIG DBL_DIG
# ifdef DBL_MANT_DIG
# ifdef DBL_MAX
# define NV_MAX DBL_MAX
# endif
+# ifdef DBL_MIN_EXP
+# define NV_MIN_EXP DBL_MIN_EXP
+# endif
+# ifdef DBL_MAX_EXP
+# define NV_MAX_EXP DBL_MAX_EXP
+# endif
# ifdef DBL_MIN_10_EXP
# define NV_MIN_10_EXP DBL_MIN_10_EXP
# endif
# define NV_MAX HUGE_VAL
# endif
# endif
+
+/* These math interfaces are C89. */
+# define Perl_acos acos
+# define Perl_asin asin
+# define Perl_atan atan
+# define Perl_atan2 atan2
+# define Perl_ceil ceil
# define Perl_cos cos
-# define Perl_sin sin
-# define Perl_sqrt sqrt
+# define Perl_cosh cosh
# define Perl_exp exp
-# define Perl_log log
-# define Perl_atan2 atan2
-# define Perl_pow pow
+/* no Perl_fabs, but there's PERL_ABS */
# define Perl_floor floor
-# define Perl_ceil ceil
# define Perl_fmod fmod
+# define Perl_log log
+# define Perl_log10 log10
+# define Perl_pow pow
+# define Perl_sin sin
+# define Perl_sinh sinh
+# define Perl_sqrt sqrt
+# define Perl_tan tan
+# define Perl_tanh tanh
+
# define Perl_modf(x,y) modf(x,y)
# define Perl_frexp(x,y) frexp(x,y)
+# define Perl_ldexp(x,y) ldexp(x,y)
+
+# ifndef Perl_isnan
+# ifdef HAS_ISNAN
+# define Perl_isnan(x) isnan(x)
+# endif
+# endif
+# ifndef Perl_isinf
+# if defined(HAS_ISINF)
+# define Perl_isinf(x) isinf(x)
+# elif defined(DBL_MAX) && !defined(NAN_COMPARE_BROKEN)
+# define Perl_isinf(x) ((x) > DBL_MAX || (x) < -DBL_MAX)
+# endif
+# endif
+# ifndef Perl_isfinite
+# ifdef HAS_ISFINITE
+# define Perl_isfinite(x) isfinite(x)
+# elif defined(HAS_FINITE)
+# define Perl_isfinite(x) finite(x)
+# endif
+# endif
#endif
-/* rumor has it that Win32 has _fpclass() */
+/* fpclassify(): C99. It is supposed to be a macro that switches on
+* the sizeof() of its argument, so there's no need for e.g. fpclassifyl().*/
+#if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY)
+# include <math.h>
+# if defined(FP_INFINITE) && defined(FP_NAN)
+# define Perl_fp_class(x) fpclassify(x)
+# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE)
+# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN)
+# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL)
+# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL)
+# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO)
+# elif defined(FP_PLUS_INF) && defined(FP_QNAN)
+/* Some versions of HP-UX (10.20) have (only) fpclassify() but which is
+ * actually not the C99 fpclassify, with its own set of return defines. */
+# define Perl_fp_class(x) fpclassify(x)
+# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF)
+# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF)
+# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN)
+# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN)
+# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM)
+# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM)
+# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM)
+# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM)
+# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO)
+# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO)
+# else
+# undef Perl_fp_class /* Unknown set of defines */
+# endif
+#endif
+
+/* fp_classify(): Legacy: VMS, maybe Unicos? The values, however,
+ * are identical to the C99 fpclassify(). */
+#if !defined(Perl_fp_class) && defined(HAS_FP_CLASSIFY)
+# include <math.h>
+# ifdef __VMS
+ /* FP_INFINITE and others are here rather than in math.h as C99 stipulates */
+# include <fp.h>
+ /* oh, and the isnormal macro has a typo in it! */
+# undef isnormal
+# define isnormal(x) Perl_fp_class_norm(x)
+# endif
+# if defined(FP_INFINITE) && defined(FP_NAN)
+# define Perl_fp_class(x) fp_classify(x)
+# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE)
+# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN)
+# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL)
+# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL)
+# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO)
+# else
+# undef Perl_fp_class /* Unknown set of defines */
+# endif
+#endif
-/* SGI has fpclassl... but not with the same result values,
- * and it's via a typedef (not via #define), so will need to redo Configure
- * to use. Not worth the trouble, IMO, at least until the below is used
- * more places. Also has fp_class_l, BTW, via fp_class.h. Feel free to check
- * with me for the SGI manpages, SGI testing, etcetera, if you want to
- * try getting this to work with IRIX. - Allen <allens@cpan.org> */
+/* Feel free to check with me for the SGI manpages, SGI testing,
+ * etcetera, if you want to try getting this to work with IRIX.
+ *
+ * - Allen <allens@cpan.org> */
+/* fpclass(): SysV, at least Solaris and some versions of IRIX. */
#if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL))
+/* Solaris and IRIX have fpclass/fpclassl, but they are using
+ * an enum typedef, not cpp symbols, and Configure doesn't detect that.
+ * Define some symbols also as cpp symbols so we can detect them. */
+# if defined(__sun) || defined(__irix__) /* XXX Configure test instead */
+# define FP_PINF FP_PINF
+# define FP_QNAN FP_QNAN
+# endif
+# include <math.h>
# ifdef I_IEEFP
# include <ieeefp.h>
# endif
# include <fp.h>
# endif
# if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL)
-# define Perl_fp_class() fpclassl(x)
+# define Perl_fp_class(x) fpclassl(x)
# else
-# define Perl_fp_class() fpclass(x)
+# define Perl_fp_class(x) fpclass(x)
# endif
-# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_CLASS_SNAN)
-# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_CLASS_QNAN)
-# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_CLASS_SNAN||Perl_fp_class(x)==FP_CLASS_QNAN)
-# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF)
-# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_CLASS_PINF)
-# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_CLASS_NINF||Perl_fp_class(x)==FP_CLASS_PINF)
-# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_CLASS_NNORM)
-# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_CLASS_PNORM)
-# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_CLASS_NNORM||Perl_fp_class(x)==FP_CLASS_PNORM)
-# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM)
-# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_CLASS_PDENORM)
-# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM||Perl_fp_class(x)==FP_CLASS_PDENORM)
-# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_CLASS_NZERO)
-# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_CLASS_PZERO)
-# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_CLASS_NZERO||Perl_fp_class(x)==FP_CLASS_PZERO)
-#endif
-
-#if !defined(Perl_fp_class) && defined(HAS_FP_CLASS) && !defined(PERL_MICRO)
-# include <math.h>
-# if !defined(FP_SNAN) && defined(I_FP_CLASS)
-# include <fp_class.h>
+# if defined(FP_CLASS_PINF) && defined(FP_CLASS_SNAN)
+# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_CLASS_SNAN)
+# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_CLASS_QNAN)
+# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF)
+# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_CLASS_PINF)
+# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_CLASS_NNORM)
+# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_CLASS_PNORM)
+# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM)
+# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_CLASS_PDENORM)
+# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_CLASS_NZERO)
+# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_CLASS_PZERO)
+# elif defined(FP_PINF) && defined(FP_QNAN)
+# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN)
+# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN)
+# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NINF)
+# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PINF)
+# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NNORM)
+# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PNORM)
+# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NDENORM)
+# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PDENORM)
+# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NZERO)
+# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PZERO)
+# else
+# undef Perl_fp_class /* Unknown set of defines */
# endif
-# define Perl_fp_class(x) fp_class(x)
-# define Perl_fp_class_snan(x) (fp_class(x)==FP_SNAN)
-# define Perl_fp_class_qnan(x) (fp_class(x)==FP_QNAN)
-# define Perl_fp_class_nan(x) (fp_class(x)==FP_SNAN||fp_class(x)==FP_QNAN)
-# define Perl_fp_class_ninf(x) (fp_class(x)==FP_NEG_INF)
-# define Perl_fp_class_pinf(x) (fp_class(x)==FP_POS_INF)
-# define Perl_fp_class_inf(x) (fp_class(x)==FP_NEG_INF||fp_class(x)==FP_POS_INF)
-# define Perl_fp_class_nnorm(x) (fp_class(x)==FP_NEG_NORM)
-# define Perl_fp_class_pnorm(x) (fp_class(x)==FP_POS_NORM)
-# define Perl_fp_class_norm(x) (fp_class(x)==FP_NEG_NORM||fp_class(x)==FP_POS_NORM)
-# define Perl_fp_class_ndenorm(x) (fp_class(x)==FP_NEG_DENORM)
-# define Perl_fp_class_pdenorm(x) (fp_class(x)==FP_POS_DENORM)
-# define Perl_fp_class_denorm(x) (fp_class(x)==FP_NEG_DENORM||fp_class(x)==FP_POS_DENORM)
-# define Perl_fp_class_nzero(x) (fp_class(x)==FP_NEG_ZERO)
-# define Perl_fp_class_pzero(x) (fp_class(x)==FP_POS_ZERO)
-# define Perl_fp_class_zero(x) (fp_class(x)==FP_NEG_ZERO||fp_class(x)==FP_POS_ZERO)
#endif
-#if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY)
+/* fp_class(): Legacy: at least Tru64, some versions of IRIX. */
+#if !defined(Perl_fp_class) && (defined(HAS_FP_CLASS)||defined(HAS_FP_CLASSL))
# include <math.h>
-# define Perl_fp_class(x) fpclassify(x)
-# define Perl_fp_class_nan(x) (fp_classify(x)==FP_SNAN||fp_classify(x)==FP_QNAN)
-# define Perl_fp_class_inf(x) (fp_classify(x)==FP_INFINITE)
-# define Perl_fp_class_norm(x) (fp_classify(x)==FP_NORMAL)
-# define Perl_fp_class_denorm(x) (fp_classify(x)==FP_SUBNORMAL)
-# define Perl_fp_class_zero(x) (fp_classify(x)==FP_ZERO)
+# if !defined(FP_SNAN) && defined(I_FP_CLASS)
+# include <fp_class.h>
+# endif
+# if defined(FP_POS_INF) && defined(FP_QNAN)
+# ifdef __irix__ /* XXX Configure test instead */
+# ifdef USE_LONG_DOUBLE
+# define Perl_fp_class(x) fp_class_l(x)
+# else
+# define Perl_fp_class(x) fp_class_d(x)
+# endif
+# else
+# if defined(USE_LONG_DOUBLE) && defined(HAS_FP_CLASSL)
+# define Perl_fp_class(x) fp_classl(x)
+# else
+# define Perl_fp_class(x) fp_class(x)
+# endif
+# endif
+# if defined(FP_POS_INF) && defined(FP_QNAN)
+# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN)
+# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN)
+# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NEG_INF)
+# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_POS_INF)
+# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NEG_NORM)
+# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_POS_NORM)
+# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NEG_DENORM)
+# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_POS_DENORM)
+# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NEG_ZERO)
+# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_POS_ZERO)
+# else
+# undef Perl_fp_class /* Unknown set of defines */
+# endif
+# endif
#endif
+/* class(), _class(): Legacy: AIX. */
#if !defined(Perl_fp_class) && defined(HAS_CLASS)
# include <math.h>
-# ifndef _cplusplus
-# define Perl_fp_class(x) class(x)
-# else
-# define Perl_fp_class(x) _class(x)
+# if defined(FP_PLUS_NORM) && defined(FP_PLUS_INF)
+# ifndef _cplusplus
+# define Perl_fp_class(x) class(x)
+# else
+# define Perl_fp_class(x) _class(x)
+# endif
+# if defined(FP_PLUS_INF) && defined(FP_NANQ)
+# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS)
+# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ)
+# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF)
+# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF)
+# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM)
+# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM)
+# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM)
+# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM)
+# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO)
+# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO)
+# else
+# undef Perl_fp_class /* Unknown set of defines */
+# endif
# endif
-# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS)
-# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ)
-# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_SNAN||Perl_fp_class(x)==FP_QNAN)
-# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF)
-# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF)
-# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_MINUS_INF||Perl_fp_class(x)==FP_PLUS_INF)
-# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM)
-# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM)
-# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_MINUS_NORM||Perl_fp_class(x)==FP_PLUS_NORM)
-# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM)
-# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM)
-# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM||Perl_fp_class(x)==FP_PLUS_DENORM)
-# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO)
-# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO)
-# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_MINUS_ZERO||Perl_fp_class(x)==FP_PLUS_ZERO)
-#endif
-
-/* rumor has it that Win32 has _isnan() */
+#endif
-#ifndef Perl_isnan
-# ifdef HAS_ISNAN
-# define Perl_isnan(x) isnan((NV)x)
-# else
-# ifdef Perl_fp_class_nan
-# define Perl_isnan(x) Perl_fp_class_nan(x)
-# else
-# ifdef HAS_UNORDERED
-# define Perl_isnan(x) unordered((x), 0.0)
-# else
-# define Perl_isnan(x) ((x)!=(x))
-# endif
-# endif
-# endif
+/* Win32: _fpclass(), _isnan(), _finite(). */
+#ifdef WIN32
+# ifndef Perl_isnan
+# define Perl_isnan(x) _isnan(x)
+# endif
+# ifndef Perl_isfinite
+# define Perl_isfinite(x) _finite(x)
+# endif
+# ifndef Perl_fp_class_snan
+/* No simple way to #define Perl_fp_class because _fpclass()
+ * returns a set of bits. */
+# define Perl_fp_class_snan(x) (_fpclass(x) & _FPCLASS_SNAN)
+# define Perl_fp_class_qnan(x) (_fpclass(x) & _FPCLASS_QNAN)
+# define Perl_fp_class_nan(x) (_fpclass(x) & (_FPCLASS_SNAN|_FPCLASS_QNAN))
+# define Perl_fp_class_ninf(x) (_fpclass(x) & _FPCLASS_NINF))
+# define Perl_fp_class_pinf(x) (_fpclass(x) & _FPCLASS_PINF))
+# define Perl_fp_class_inf(x) (_fpclass(x) & (_FPCLASS_NINF|_FPCLASS_PINF))
+# define Perl_fp_class_nnorm(x) (_fpclass(x) & _FPCLASS_NN)
+# define Perl_fp_class_pnorm(x) (_fpclass(x) & _FPCLASS_PN)
+# define Perl_fp_class_norm(x) (_fpclass(x) & (_FPCLASS_NN|_FPCLASS_PN))
+# define Perl_fp_class_ndenorm(x) (_fpclass(x) & _FPCLASS_ND)
+# define Perl_fp_class_pdenorm(x) (_fpclass(x) & _FPCLASS_PD)
+# define Perl_fp_class_denorm(x) (_fpclass(x) & (_FPCLASS_ND|_FPCLASS_PD))
+# define Perl_fp_class_nzero(x) (_fpclass(x) & _FPCLASS_NZ)
+# define Perl_fp_class_pzero(x) (_fpclass(x) & _FPCLASS_PZ)
+# define Perl_fp_class_zero(x) (_fpclass(x) & (_FPCLASS_NZ|_FPCLASS_PZ))
+# endif
+#endif
+
+#if !defined(Perl_fp_class_inf) && \
+ defined(Perl_fp_class_pinf) && defined(Perl_fp_class_ninf)
+# define Perl_fp_class_inf(x) \
+ (Perl_fp_class_pinf(x) || Perl_fp_class_ninf(x))
+#endif
+
+#if !defined(Perl_fp_class_nan) && \
+ defined(Perl_fp_class_snan) && defined(Perl_fp_class_qnan)
+# define Perl_fp_class_nan(x) \
+ (Perl_fp_class_snan(x) || Perl_fp_class_qnan(x))
+#endif
+
+#if !defined(Perl_fp_class_zero) && \
+ defined(Perl_fp_class_pzero) && defined(Perl_fp_class_nzero)
+# define Perl_fp_class_zero(x) \
+ (Perl_fp_class_pzero(x) || Perl_fp_class_nzero(x))
+#endif
+
+#if !defined(Perl_fp_class_norm) && \
+ defined(Perl_fp_class_pnorm) && defined(Perl_fp_class_nnorm)
+# define Perl_fp_class_norm(x) \
+ (Perl_fp_class_pnorm(x) || Perl_fp_class_nnorm(x))
+#endif
+
+#if !defined(Perl_fp_class_denorm) && \
+ defined(Perl_fp_class_pdenorm) && defined(Perl_fp_class_ndenorm)
+# define Perl_fp_class_denorm(x) \
+ (Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x))
#endif
#ifdef UNDER_CE
int isnan(double d);
#endif
-#ifndef Perl_isinf
-# ifdef HAS_ISINF
-# define Perl_isinf(x) isinf((NV)x)
+#ifndef Perl_isnan
+# ifdef Perl_fp_class_nan
+# define Perl_isnan(x) Perl_fp_class_nan(x)
# else
-# ifdef Perl_fp_class_inf
-# define Perl_isinf(x) Perl_fp_class_inf(x)
+# ifdef HAS_UNORDERED
+# define Perl_isnan(x) unordered((x), 0.0)
# else
-# define Perl_isinf(x) ((x)==NV_INF)
+# define Perl_isnan(x) ((x)!=(x))
# endif
# endif
#endif
+#ifndef Perl_isinf
+# ifdef Perl_fp_class_inf
+# define Perl_isinf(x) Perl_fp_class_inf(x)
+# endif
+#endif
+
#ifndef Perl_isfinite
-# ifdef HAS_FINITE
-# define Perl_isfinite(x) finite((NV)x)
+# if defined(HAS_ISFINITE) && !defined(isfinite)
+# define Perl_isfinite(x) isfinite((double)(x))
+# elif defined(HAS_FINITE)
+# define Perl_isfinite(x) finite((double)(x))
+# elif defined(Perl_fp_class_finite)
+# define Perl_isfinite(x) Perl_fp_class_finite(x)
# else
-# ifdef HAS_ISFINITE
-# define Perl_isfinite(x) isfinite(x)
-# else
-# ifdef Perl_fp_class_finite
-# define Perl_isfinite(x) Perl_fp_class_finite(x)
-# else
-# define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x))
-# endif
-# endif
+/* For the infinities the multiplication returns nan,
+ * for the nan the multiplication also returns nan,
+ * for everything else (that is, finite) zero should be returned. */
+# define Perl_isfinite(x) (((x) * 0) == 0)
+# endif
+#endif
+
+#ifndef Perl_isinf
+# if defined(Perl_isfinite) && defined(Perl_isnan)
+# define Perl_isinf(x) !(Perl_isfinite(x)||Perl_isnan(x))
# endif
#endif
+/* We need Perl_isfinitel (ends with ell) (if available) even when
+ * not USE_LONG_DOUBLE because the printf code (sv_catpvfn_flags)
+ * needs that. */
+#if defined(HAS_LONG_DOUBLE) && !defined(Perl_isfinitel)
+/* If isfinite() is a macro and looks like we have C99,
+ * we assume it's the type-aware C99 isfinite(). */
+# if defined(HAS_ISFINITE) && defined(isfinite) && defined(HAS_C99)
+# define Perl_isfinitel(x) isfinite(x)
+# elif defined(HAS_ISFINITEL)
+# define Perl_isfinitel(x) isfinitel(x)
+# elif defined(HAS_FINITEL)
+# define Perl_isfinitel(x) finitel(x)
+# elif defined(HAS_INFL) && defined(HAS_NANL)
+# define Perl_isfinitel(x) !(isinfl(x)||isnanl(x))
+# else
+# define Perl_isfinitel(x) ((x) * 0 == 0) /* See Perl_isfinite. */
+# endif
+#endif
+
/* The default is to use Perl's own atof() implementation (in numeric.c).
* Usually that is the one to use but for some platforms (e.g. UNICOS)
* it is however best to use the native implementation of atof.
#endif
-struct RExC_state_t;
-struct _reg_trie_data;
-
typedef MEM_SIZE STRLEN;
-#ifdef PERL_MAD
-typedef struct token TOKEN;
-typedef struct madprop MADPROP;
-typedef struct nexttoken NEXTTOKE;
-#endif
typedef struct op OP;
typedef struct cop COP;
typedef struct unop UNOP;
+typedef struct unop_aux UNOP_AUX;
typedef struct binop BINOP;
typedef struct listop LISTOP;
typedef struct logop LOGOP;
typedef struct padop PADOP;
typedef struct pvop PVOP;
typedef struct loop LOOP;
+typedef struct methop METHOP;
#ifdef PERL_CORE
typedef struct opslab OPSLAB;
typedef struct ptr_tbl PTR_TBL_t;
typedef struct clone_params CLONE_PARAMS;
-/* a pad or name pad is currently just an AV; but that might change,
+/* a pad is currently just an AV; but that might change,
* so hide the type. */
typedef struct padlist PADLIST;
typedef AV PAD;
-typedef AV PADNAMELIST;
-typedef SV PADNAME;
+typedef struct padnamelist PADNAMELIST;
+typedef struct padname PADNAME;
/* enable PERL_NEW_COPY_ON_WRITE by default */
#if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW)
# define PERL_SAWAMPERSAND
#endif
+#if defined(PERL_DEBUG_READONLY_OPS) && !defined(USE_ITHREADS)
+# error PERL_DEBUG_READONLY_OPS only works with ithreads
+#endif
+
#include "handy.h"
#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
# else
# include "dosish.h"
# endif
-# define ISHISH "dos"
-#endif
-
-#if defined(VMS)
+#elif defined(VMS)
# include "vmsish.h"
-# define ISHISH "vms"
-#endif
-
-#if defined(PLAN9)
+#elif defined(PLAN9)
# include "./plan9/plan9ish.h"
-# define ISHISH "plan9"
-#endif
-
-#if defined(__VOS__)
+#elif defined(__VOS__)
# ifdef __GNUC__
# include "./vos/vosish.h"
# else
# include "vos/vosish.h"
# endif
-# define ISHISH "vos"
-#endif
-
-#ifdef __SYMBIAN32__
+#elif defined(__SYMBIAN32__)
# include "symbian/symbianish.h"
-# define ISHISH "symbian"
-#endif
-
-
-#if defined(__HAIKU__)
+#elif defined(__HAIKU__)
# include "haiku/haikuish.h"
-# define ISHISH "haiku"
-#endif
-
-#ifndef ISHISH
+#else
# include "unixish.h"
-# define ISHISH "unix"
#endif
/* NSIG logic from Configure --> */
# define PERL_FPU_POST_EXEC }
#endif
+/* In Tru64 the cc -ieee enables the IEEE math but disables traps.
+ * We need to reenable the "invalid" trap because otherwise generation
+ * of NaN values leaves the IEEE fp flags in bad state, leaving any further
+ * fp ops behaving strangely (Inf + 1 resulting in zero, for example). */
+#ifdef __osf__
+# include <machine/fpu.h>
+# define PERL_SYS_FPU_INIT \
+ STMT_START { \
+ ieee_set_fp_control(IEEE_TRAP_ENABLE_INV); \
+ signal(SIGFPE, SIG_IGN); \
+ } STMT_END
+#endif
+
+#ifndef PERL_SYS_FPU_INIT
+# define PERL_SYS_FPU_INIT NOOP
+#endif
+
#ifndef PERL_SYS_INIT3_BODY
# define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp)
#endif
/*
+=head1 Miscellaneous Functions
+
=for apidoc Am|void|PERL_SYS_INIT|int *argc|char*** argv
Provides system-specific tune up of the C runtime environment necessary to
-run Perl interpreters. This should be called only once, before creating
+run Perl interpreters. This should be called only once, before creating
any Perl interpreters.
=for apidoc Am|void|PERL_SYS_INIT3|int *argc|char*** argv|char*** env
Provides system-specific tune up of the C runtime environment necessary to
-run Perl interpreters. This should be called only once, before creating
+run Perl interpreters. This should be called only once, before creating
any Perl interpreters.
=for apidoc Am|void|PERL_SYS_TERM|
Provides system-specific clean up of the C runtime environment after
-running Perl interpreters. This should be called only once, after
+running Perl interpreters. This should be called only once, after
freeing any remaining Perl interpreters.
=cut
# else
# ifdef I_MACH_CTHREADS
# include <mach/cthreads.h>
-# if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC)
-# define MUTEX_INIT_CALLS_MALLOC
-# endif
typedef cthread_t perl_os_thread;
typedef mutex_t perl_mutex;
typedef condition_t perl_cond;
* out there, Solaris being the most prominent.
*/
#ifndef PERL_FLUSHALL_FOR_CHILD
-# if defined(USE_PERLIO) || defined(FFLUSH_NULL) || defined(USE_SFIO)
+# if defined(USE_PERLIO) || defined(FFLUSH_NULL)
# define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL)
# else
# ifdef FFLUSH_ALL
/* Takes three arguments: is_utf8, length, str */
#ifndef UTF8f
-# define UTF8f "d%"UVuf"%4p"
+# define UTF8f "d%" UVuf "%4p"
#endif
#define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p)
-#ifdef PERL_CORE
-/* not used; but needed for backward compatibility with XS code? - RMB */
-# undef VDf
-#else
-# ifndef VDf
-# define VDf "vd"
-# endif
-#endif
+#define PNf UTF8f
+#define PNfARG(pn) (int)1, (UV)PadnameLEN(pn), (void *)PadnamePV(pn)
#ifdef PERL_CORE
/* not used; but needed for backward compatibility with XS code? - RMB */
# define __attribute__warn_unused_result__
#endif
+#ifdef I_ASSERT
+# if !defined(DEBUGGING) && !defined(NDEBUG)
+# define NDEBUG 1
+# endif
+# include <assert.h>
+#endif
+
/* For functions that are marked as __attribute__noreturn__, it's not
appropriate to call return. In either case, include the lint directive.
*/
#ifdef HASATTRIBUTE_NORETURN
-# define NORETURN_FUNCTION_END assert(0); /* NOTREACHED */
+# define NORETURN_FUNCTION_END NOT_REACHED; /* NOTREACHED */
#else
-# define NORETURN_FUNCTION_END assert(0); /* NOTREACHED */ return 0
+# define NORETURN_FUNCTION_END NOT_REACHED; /* NOTREACHED */ return 0
#endif
/* Some OS warn on NULL format to printf */
/* placeholder */
#endif
+#if defined(static_assert) || (defined(__cplusplus) && __cplusplus >= 201103L)
+/* static_assert is a macro defined in <assert.h> in C11 or a compiler
+ builtin in C++11.
+*/
+# define STATIC_ASSERT_GLOBAL(COND) static_assert(COND, #COND)
+#else
+/* We use a bit-field instead of an array because gcc accepts
+ 'typedef char x[n]' where n is not a compile-time constant.
+ We want to enforce constantness.
+*/
+# define STATIC_ASSERT_2(COND, SUFFIX) \
+ typedef struct { \
+ unsigned int _static_assertion_failed_##SUFFIX : (COND) ? 1 : -1; \
+ } _static_assertion_failed_##SUFFIX PERL_UNUSED_DECL
+# define STATIC_ASSERT_1(COND, SUFFIX) STATIC_ASSERT_2(COND, SUFFIX)
+# define STATIC_ASSERT_GLOBAL(COND) STATIC_ASSERT_1(COND, __LINE__)
+#endif
+/* We need this wrapper even in C11 because 'case X: static_assert(...);' is an
+ error (static_assert is a declaration, and only statements can have labels).
+*/
+#define STATIC_ASSERT_STMT(COND) do { STATIC_ASSERT_GLOBAL(COND); } while (0)
+
+#ifndef __has_builtin
+# define __has_builtin(x) 0 /* not a clang style compiler */
+#endif
+
+/* ASSUME is like assert(), but it has a benefit in a release build. It is a
+ hint to a compiler about a statement of fact in a function call free
+ expression, which allows the compiler to generate better machine code.
+ In a debug build, ASSUME(x) is a synonym for assert(x). ASSUME(0) means
+ the control path is unreachable. In a for loop, ASSUME can be used to hint
+ that a loop will run at least X times. ASSUME is based off MSVC's __assume
+ intrinsic function, see its documents for more details.
+*/
+
+#ifndef DEBUGGING
+# if __has_builtin(__builtin_unreachable) \
+ || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4) /* 4.5 -> */
+# define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable())
+# elif defined(_MSC_VER)
+# define ASSUME(x) __assume(x)
+# 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
+#else
+# define ASSUME(x) assert(x)
+#endif
+
+#define NOT_REACHED ASSUME(0)
+
/* Some unistd.h's give a prototype for pause() even though
HAS_PAUSE ends up undefined. This causes the #define
below to be rejected by the compiler. Sigh.
union any {
void* any_ptr;
I32 any_i32;
+ U32 any_u32;
IV any_iv;
UV any_uv;
long any_long;
&& idx >= AvFILLp(PL_parser->rsfp_filters))
#define PERL_FILTER_EXISTS(i) \
(PL_parser && PL_parser->rsfp_filters \
- && (i) <= av_len(PL_parser->rsfp_filters))
+ && (i) <= av_tindex(PL_parser->rsfp_filters))
#if defined(_AIX) && !defined(_AIX43)
#if defined(USE_REENTRANT) || defined(_REENTRANT) || defined(_THREAD_SAFE)
#endif
#include "perly.h"
-#ifdef PERL_MAD
-struct nexttoken {
- YYSTYPE next_val; /* value of next token, if any */
- I32 next_type; /* type of next token */
- MADPROP *next_mad; /* everything else about that token */
-};
-#endif
/* macros to define bit-fields in structs. */
#ifndef PERL_BITFIELD8
typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
-struct scan_data_t; /* Used in S_* functions in regcomp.c */
-struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
+
+/* These have to be predeclared, as they are used in proto.h which is #included
+ * before their definitions in regcomp.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_ssc regnode_ssc;
+typedef struct RExC_state_t RExC_state_t;
+struct _reg_trie_data;
+
+#endif
struct ptr_tbl_ent {
struct ptr_tbl_ent* next;
#define U_32(n) ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \
: ((n) < U32_MAX_P1 ? (U32) (n) \
: ((n) > 0 ? U32_MAX : 0 /* NaN */)))
-#define I_V(n) ((n) < IV_MAX_P1 ? ((n) < IV_MIN ? IV_MIN : (IV) (n)) \
- : ((n) < UV_MAX_P1 ? (IV)(UV) (n) \
+#define I_V(n) (LIKELY((n) < IV_MAX_P1) ? (UNLIKELY((n) < IV_MIN) ? IV_MIN : (IV) (n)) \
+ : (LIKELY((n) < UV_MAX_P1) ? (IV)(UV) (n) \
: ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */)))
-#define U_V(n) ((n) < 0.0 ? ((n) < IV_MIN ? (UV) IV_MIN : (UV)(IV) (n)) \
- : ((n) < UV_MAX_P1 ? (UV) (n) \
+#define U_V(n) ((n) < 0.0 ? (UNLIKELY((n) < IV_MIN) ? (UV) IV_MIN : (UV)(IV) (n)) \
+ : (LIKELY((n) < UV_MAX_P1) ? (UV) (n) \
: ((n) > 0 ? UV_MAX : 0 /* NaN */)))
#endif
#define DEBUG_q_FLAG 0x00800000 /*8388608 */
#define DEBUG_M_FLAG 0x01000000 /*16777216*/
#define DEBUG_B_FLAG 0x02000000 /*33554432*/
-#define DEBUG_MASK 0x03FFEFFF /* mask of all the standard flags */
+#define DEBUG_L_FLAG 0x04000000 /*67108864*/
+#define DEBUG_MASK 0x07FFEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
# define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
# define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG)
# define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG)
+# define DEBUG_L_TEST_ (PL_debug & DEBUG_L_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_q_TEST DEBUG_q_TEST_
# define DEBUG_M_TEST DEBUG_M_TEST_
# define DEBUG_B_TEST DEBUG_B_TEST_
+# define DEBUG_L_TEST DEBUG_L_TEST_
# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
# define DEBUG_Uv_TEST DEBUG_Uv_TEST_
# define DEBUG_Pv_TEST DEBUG_Pv_TEST_
# define PERL_DEB(a) a
+# define PERL_DEB2(a,b) a
# define PERL_DEBUG(a) if (PL_debug) a
# define DEBUG_p(a) if (DEBUG_p_TEST) a
# define DEBUG_s(a) if (DEBUG_s_TEST) a
# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
# define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a)
# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a)
+# define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a)
#else /* DEBUGGING */
# define DEBUG_q_TEST (0)
# define DEBUG_M_TEST (0)
# define DEBUG_B_TEST (0)
+# define DEBUG_L_TEST (0)
# define DEBUG_Xv_TEST (0)
# define DEBUG_Uv_TEST (0)
# define DEBUG_Pv_TEST (0)
# define PERL_DEB(a)
+# define PERL_DEB2(a,b) b
# define PERL_DEBUG(a)
# define DEBUG_p(a)
# define DEBUG_s(a)
# define DEBUG_q(a)
# define DEBUG_M(a)
# define DEBUG_B(a)
+# define DEBUG_L(a)
# define DEBUG_Xv(a)
# define DEBUG_Uv(a)
# define DEBUG_Pv(a)
where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \
__FILE__, __LINE__));
-#if defined(DEBUGGING) && defined(I_ASSERT)
-# include <assert.h>
-#endif
-
/* Keep the old croak based assert for those who want it, and as a fallback if
the platform is so heretically non-ANSI that it can't assert. */
-#define Perl_assert(what) PERL_DEB( \
+#define Perl_assert(what) PERL_DEB2( \
((what) ? ((void) 0) : \
(Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \
"\", line %d", STRINGIFY(what), __LINE__), \
- (void) 0)))
+ (void) 0)), ((void)0))
+/* assert() gets defined if DEBUGGING (and I_ASSERT).
+ * If no DEBUGGING, the <assert.h> has not been included. */
#ifndef assert
# define assert(what) Perl_assert(what)
#endif
#ifdef I_MATH
# include <math.h>
+# ifdef __VMS
+ /* isfinite and others are here rather than in math.h as C99 stipulates */
+# include <fp.h>
+# endif
#else
START_EXTERN_C
double exp (double);
END_EXTERN_C
#endif
-#if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(LDBL_INFINITY)
-# define NV_INF LDBL_INFINITY
+#ifdef WIN32
+# if !defined(NV_INF) && defined(HUGE_VAL)
+# define NV_INF HUGE_VAL
+# endif
+/* For WIN32 the best NV_NAN is the __PL_nan_u trick, see below.
+ * There is no supported way of getting the NAN across all the crts. */
+#endif
+
+/* If you are thinking of using HUGE_VAL for infinity, or using
+ * <math.h> functions to generate NV_INF (e.g. exp(1e9), log(-1.0)),
+ * stop. Neither will work portably: HUGE_VAL can be just DBL_MAX,
+ * and the math functions might be just generating DBL_MAX, or even
+ * zero. */
+
+#if !defined(NV_INF) && defined(USE_LONG_DOUBLE)
+# if !defined(NV_INF) && defined(LDBL_INFINITY)
+# define NV_INF LDBL_INFINITY
+# endif
+# if !defined(NV_INF) && defined(INFINITYL)
+# define NV_INF INFINITYL
+# endif
#endif
#if !defined(NV_INF) && defined(DBL_INFINITY)
# define NV_INF (NV)DBL_INFINITY
#if !defined(NV_INF) && defined(INF)
# define NV_INF (NV)INF
#endif
-#if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
-# define NV_INF (NV)HUGE_VALL
+#if !defined(NV_INF)
+# if INTSIZE == 4
+/* At this point we assume the IEEE 754 floating point (and of course,
+ * we also assume a floating point format that can encode an infinity).
+ * We will coerce an int32 (which will encode the infinity) into
+ * a 32-bit float, which will then be cast into NV.
+ *
+ * Note that we intentionally use a float and 32-bit int, instead of
+ * shifting a small integer into a full IV, and from that into a full
+ * NV, because:
+ *
+ * (1) an IV might not be wide enough to cover all the bits of an NV.
+ * (2) the exponent part (including the infinity and nan bits) of a NV
+ * might be wider than just 16 bits.
+ *
+ * Below the NV_NAN logic has similar __PL_nan_u fallback, the only
+ * difference being the int32 constant being coerced. */
+# define __PL_inf_float_int32 0x7F800000
+static const union { unsigned int __i; float __f; } __PL_inf_u =
+ { __PL_inf_float_int32 };
+# define NV_INF ((NV)(__PL_inf_u.__f))
+# endif
#endif
-#if !defined(NV_INF) && defined(HUGE_VAL)
-# define NV_INF (NV)HUGE_VAL
+#if !defined(NV_INF)
+# define NV_INF ((NV)1.0/0.0) /* Some compilers will warn. */
#endif
#if !defined(NV_NAN) && defined(USE_LONG_DOUBLE)
# if !defined(NV_NAN) && defined(LDBL_NAN)
# define NV_NAN LDBL_NAN
# endif
+# if !defined(NV_NAN) && defined(NANL)
+# define NV_NAN NANL
+# endif
# if !defined(NV_NAN) && defined(LDBL_QNAN)
# define NV_NAN LDBL_QNAN
# endif
#if !defined(NV_NAN) && defined(DBL_SNAN)
# define NV_NAN (NV)DBL_SNAN
#endif
+#if !defined(NV_NAN) && defined(NAN)
+# define NV_NAN (NV)NAN
+#endif
#if !defined(NV_NAN) && defined(QNAN)
# define NV_NAN (NV)QNAN
#endif
#if !defined(NV_NAN) && defined(SNAN)
# define NV_NAN (NV)SNAN
#endif
-#if !defined(NV_NAN) && defined(NAN)
-# define NV_NAN (NV)NAN
+#if !defined(NV_NAN)
+# if INTSIZE == 4
+/* See the discussion near __PL_inf_u. */
+# define __PL_nan_float_int32 0x7FC00000
+static const union { unsigned int __i; float __f; } __PL_nan_u =
+ { __PL_nan_float_int32 };
+# define NV_NAN ((NV)(__PL_nan_u.__f))
+# endif
#endif
+#if !defined(NV_NAN)
+# define NV_NAN ((NV)0.0/0.0) /* Some compilers will warn. */
+#endif
+/* Do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF).
+ * Though IEEE-754-logically correct, some compilers (like Visual C 2003)
+ * falsely misoptimize that to zero (x-x is zero, right?) */
#ifndef __cplusplus
-# if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */
-char *crypt (); /* Maybe more hosts will need the unprototyped version */
-# else
-# if !defined(WIN32) && !defined(VMS)
+# if !defined(WIN32) && !defined(VMS)
#ifndef crypt
char *crypt (const char*, const char*);
#endif
-# endif /* !WIN32 */
-# endif /* !NeXT && !__NeXT__ */
+# endif /* !WIN32 */
# ifndef DONT_DECLARE_STD
# ifndef getenv
char *getenv (const char*);
# define RUNOPS_DEFAULT Perl_runops_standard
#endif
-#ifdef USE_PERLIO
+#if defined(USE_PERLIO)
EXTERN_C void PerlIO_teardown(void);
# ifdef USE_ITHREADS
# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex)
struct perl_memory_debug_header;
struct perl_memory_debug_header {
tTHX interpreter;
-# ifdef PERL_POISON
+# if defined(PERL_POISON) || defined(PERL_DEBUG_READONLY_COW)
MEM_SIZE size;
# endif
struct perl_memory_debug_header *prev;
struct perl_memory_debug_header *next;
+# ifdef PERL_DEBUG_READONLY_COW
+ bool readonly;
+# endif
};
-# define sTHX (sizeof(struct perl_memory_debug_header) + \
+#elif defined(PERL_DEBUG_READONLY_COW)
+
+struct perl_memory_debug_header;
+struct perl_memory_debug_header {
+ MEM_SIZE size;
+};
+
+#endif
+
+#if defined (PERL_TRACK_MEMPOOL) || defined (PERL_DEBUG_READONLY_COW)
+
+# define PERL_MEMORY_DEBUG_HEADER_SIZE \
+ (sizeof(struct perl_memory_debug_header) + \
(MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
%MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
#else
-# define sTHX 0
+# define PERL_MEMORY_DEBUG_HEADER_SIZE 0
#endif
#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
-# else
+# else
+# define INIT_TRACK_MEMPOOL(header, interp) \
+ STMT_START { \
+ (header).interpreter = (interp); \
+ (header).prev = (header).next = &(header); \
+ } STMT_END
+# endif
+# else
# define INIT_TRACK_MEMPOOL(header, interp)
#endif
#ifdef MYMALLOC
# define Perl_safesysmalloc_size(where) Perl_malloced_size(where)
#else
-# ifdef HAS_MALLOC_SIZE
+# if defined(HAS_MALLOC_SIZE) && !defined(PERL_DEBUG_READONLY_COW)
# ifdef PERL_TRACK_MEMPOOL
# define Perl_safesysmalloc_size(where) \
- (malloc_size(((char *)(where)) - sTHX) - sTHX)
+ (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) + sTHX) - sTHX)
+ (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
typedef bool (*destroyable_proc_t) (pTHX_ SV *sv);
typedef void (*despatch_signals_proc_t) (pTHX);
-/* NeXT has problems with crt0.o globals */
-#if defined(__DYNAMIC__) && \
- (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN))
-# if defined(NeXT) || defined(__NeXT)
-# include <mach-o/dyld.h>
-# define environ (*environ_pointer)
-EXT char *** environ_pointer;
-# else
-# if defined(PERL_DARWIN) && defined(PERL_CORE)
-# include <crt_externs.h> /* for the env array */
-# define environ (*_NSGetEnviron())
-# endif
-# endif
+#if defined(__DYNAMIC__) && defined(PERL_DARWIN) && defined(PERL_CORE)
+# include <crt_externs.h> /* for the env array */
+# define environ (*_NSGetEnviron())
#else
/* VMS and some other platforms don't use the environ array */
# ifdef USE_ENVIRON_ARRAY
# if !defined(DONT_DECLARE_STD) || \
- (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
+ (defined(__svr4__) && defined(__GNUC__) && defined(__sun)) || \
defined(__sgi)
extern char ** environ; /* environment variables supplied via exec */
# endif
EXTCONST char PL_warn_uninit[]
INIT("Use of uninitialized value%s%s%s");
EXTCONST char PL_warn_uninit_sv[]
- INIT("Use of uninitialized value%"SVf"%s%s");
+ INIT("Use of uninitialized value%" SVf "%s%s");
EXTCONST char PL_warn_nosemi[]
INIT("Semicolon seems to be missing");
EXTCONST char PL_warn_reserved[]
INIT("Unsuccessful %s on filename containing newline");
EXTCONST char PL_no_wrongref[]
INIT("Can't use %s ref as %s ref");
-/* The core no longer needs these here. If you require the string constant,
+/* The core no longer needs this here. If you require the string constant,
please inline a copy into your own code. */
EXTCONST char PL_no_symref[] __attribute__deprecated__
INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
-EXTCONST char PL_no_symref_sv[] __attribute__deprecated__
- INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use");
+EXTCONST char PL_no_symref_sv[]
+ INIT("Can't use string (\"%" SVf32 "\"%s) as %s ref while \"strict refs\" in use");
+
EXTCONST char PL_no_usym[]
INIT("Can't use an undefined value as %s reference");
EXTCONST char PL_no_aelem[]
INIT("Modification of non-creatable array value attempted, subscript %d");
EXTCONST char PL_no_helem_sv[]
- INIT("Modification of non-creatable hash value attempted, subscript \"%"SVf"\"");
+ INIT("Modification of non-creatable hash value attempted, subscript \"%" SVf "\"");
EXTCONST char PL_no_modify[]
INIT("Modification of a read-only value attempted");
EXTCONST char PL_no_mem[sizeof("Out of memory!\n")]
EXTCONST char PL_no_func[]
INIT("The %s function is unimplemented");
EXTCONST char PL_no_myglob[]
- INIT("\"%s\" variable %s can't be in a package");
+ INIT("\"%s\" %se %s can't be in a package");
EXTCONST char PL_no_localize_ref[]
INIT("Can't localize through a reference");
EXTCONST char PL_memory_wrap[]
# ifdef PERLIO_LAYERS
" PERLIO_LAYERS"
# endif
+# ifdef PERL_DEBUG_READONLY_COW
+ " PERL_DEBUG_READONLY_COW"
+# endif
# ifdef PERL_DEBUG_READONLY_OPS
" PERL_DEBUG_READONLY_OPS"
# endif
# ifdef PERL_GLOBAL_STRUCT
" PERL_GLOBAL_STRUCT"
# endif
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ " PERL_GLOBAL_STRUCT_PRIVATE"
+# endif
# ifdef PERL_IMPLICIT_CONTEXT
" PERL_IMPLICIT_CONTEXT"
# endif
# ifdef PERL_IMPLICIT_SYS
" PERL_IMPLICIT_SYS"
# endif
-# ifdef PERL_MAD
- " PERL_MAD"
-# endif
# ifdef PERL_MICRO
" PERL_MICRO"
# endif
# ifdef USE_LOCALE_NUMERIC
" USE_LOCALE_NUMERIC"
# endif
+# ifdef USE_LOCALE_TIME
+ " USE_LOCALE_TIME"
+# endif
# ifdef USE_LONG_DOUBLE
" USE_LONG_DOUBLE"
# endif
# ifdef USE_PERLIO
" USE_PERLIO"
# endif
+# ifdef USE_QUADMATH
+ " USE_QUADMATH"
+# endif
# ifdef USE_REENTRANT_API
" USE_REENTRANT_API"
# endif
-# ifdef USE_SFIO
- " USE_SFIO"
-# endif
# ifdef USE_SOCKS
" USE_SOCKS"
# endif
XATTRBLOCK,
XATTRTERM,
XTERMBLOCK,
+ XBLOCKTERM,
+ XPOSTDEREF,
XTERMORDORDOR /* evil hack */
/* update exp_name[] in toke.c if adding to this enum */
} expectation;
/* 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. */
+ However, bitops store HINT_INTEGER in their op_private.
+
+ NOTE: The typical module using these has the bit value hard-coded, so don't
+ blindly change the values of these.
+
+ If we run out of bits, the 2 locale ones could be combined. The PARTIAL one
+ is for "use locale 'FOO'" which excludes some categories. It requires going
+ to %^H to find out which are in and which are out. This could be extended
+ for the normal case of a plain HINT_LOCALE, so that %^H would be used for
+ any locale form. */
#define HINT_INTEGER 0x00000001 /* integer pragma */
#define HINT_STRICT_REFS 0x00000002 /* strict pragma */
#define HINT_LOCALE 0x00000004 /* locale pragma */
#define HINT_BYTES 0x00000008 /* bytes pragma */
-#define HINT_LOCALE_NOT_CHARS 0x00000010 /* locale ':not_characters' pragma */
+#define HINT_LOCALE_PARTIAL 0x00000010 /* locale, but a subset of categories */
#define HINT_EXPLICIT_STRICT_REFS 0x00000020 /* strict.pm */
#define HINT_EXPLICIT_STRICT_SUBS 0x00000040 /* strict.pm */
#define HINT_FEATURE_MASK 0x1c000000 /* 3 bits for feature bundles */
- /* Note: Used for NATIVE_HINTS, currently
- defined by vms/vmsish.h:
+ /* Note: Used for HINT_M_VMSISH_*,
+ currently defined by vms/vmsish.h:
0x40000000
0x80000000
*/
(SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT)
#endif
+/* Used for debugvar magic */
+#define DBVARMG_SINGLE 0
+#define DBVARMG_TRACE 1
+#define DBVARMG_SIGNAL 2
+#define DBVARMG_COUNT 3
+
+#define PL_DBsingle_iv (PL_DBcontrol[DBVARMG_SINGLE])
+#define PL_DBtrace_iv (PL_DBcontrol[DBVARMG_TRACE])
+#define PL_DBsignal_iv (PL_DBcontrol[DBVARMG_SIGNAL])
+
/* Various states of the input record separator SV (rs) */
#define RsSNARF(sv) (! SvOK(sv))
#define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))
#if !defined(PERL_FOR_X2P)
# include "embedvar.h"
#endif
-#ifndef PERL_MAD
-# undef PL_madskills
-# undef PL_xmlfp
-# define PL_madskills 0
-# define PL_xmlfp 0
-#endif
/* Now include all the 'global' variables
* If we don't have threads or multiple interpreters
In particular, need the relevant *ish file included already, as it may
define HAVE_INTERP_INTERN */
#include "embed.h"
-#ifndef PERL_MAD
-# undef op_getmad
-# define op_getmad(arg,pegop,slot) NOOP
-#endif
#ifndef PERL_GLOBAL_STRUCT
START_EXTERN_C
#undef PERLVARI
#undef PERLVARIC
+#if !defined(MULTIPLICITY)
+/* Set up PERLVAR macros for populating structs */
+# define PERLVAR(prefix,var,type) type prefix##var;
+/* 'var' is an array of length 'n' */
+# define PERLVARA(prefix,var,n,type) type prefix##var[n];
+/* initialize 'var' to init' */
+# define PERLVARI(prefix,var,type,init) type prefix##var;
+/* like PERLVARI, but make 'var' a const */
+# define PERLVARIC(prefix,var,type,init) type prefix##var;
+
+/* this is never instantiated, is it just used for sizeof(struct PerlHandShakeInterpreter) */
+struct PerlHandShakeInterpreter {
+# include "intrpvar.h"
+};
+# undef PERLVAR
+# undef PERLVARA
+# undef PERLVARI
+# undef PERLVARIC
+#endif
+
START_EXTERN_C
/* dummy variables that hold pointers to both runops functions, thus forcing
EXTCONST runops_proc_t PL_runops_dbg
INIT(Perl_runops_debug);
-/* PERL_GLOBAL_STRUCT_PRIVATE wants to keep global data like the
- * magic vtables const, but this is incompatible with SWIG which
- * does want to modify the vtables. */
-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
-# define EXT_MGVTBL EXTCONST MGVTBL
-#else
-# define EXT_MGVTBL EXT MGVTBL
-#endif
+#define EXT_MGVTBL EXTCONST MGVTBL
#define PERL_MAGIC_READONLY_ACCEPTABLE 0x40
#define PERL_MAGIC_VALUE_MAGIC 0x80
#endif
+
+/* if these never got defined, they need defaults */
+#ifndef PERL_SET_CONTEXT
+# define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i)
+#endif
+
+#ifndef PERL_GET_CONTEXT
+# define PERL_GET_CONTEXT PERL_GET_INTERP
+#endif
+
+#ifndef PERL_GET_THX
+# define PERL_GET_THX ((void*)NULL)
+#endif
+
+#ifndef PERL_SET_THX
+# define PERL_SET_THX(t) 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
#define PERLDBf_SAVESRC_NOSUBS 0x800 /* Including evals that generate no subroutines */
#define PERLDBf_SAVESRC_INVALID 0x1000 /* Save source that did not compile */
-#define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB))
-#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE))
-#define PERLDB_NOOPT (PL_perldb && (PL_perldb & PERLDBf_NOOPT))
-#define PERLDB_INTER (PL_perldb && (PL_perldb & PERLDBf_INTER))
-#define PERLDB_SUBLINE (PL_perldb && (PL_perldb & PERLDBf_SUBLINE))
-#define PERLDB_SINGLE (PL_perldb && (PL_perldb & PERLDBf_SINGLE))
-#define PERLDB_SUB_NN (PL_perldb && (PL_perldb & (PERLDBf_NONAME)))
-#define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO))
-#define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL))
-#define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
-#define PERLDB_SAVESRC (PL_perldb && (PL_perldb & PERLDBf_SAVESRC))
-#define PERLDB_SAVESRC_NOSUBS (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS))
-#define PERLDB_SAVESRC_INVALID (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID))
-
-#ifdef USE_LOCALE_NUMERIC
-
-#define SET_NUMERIC_STANDARD() \
- set_numeric_standard();
-
-#define SET_NUMERIC_LOCAL() \
- set_numeric_local();
-
-/* Returns non-zero If the plain locale pragma without a parameter is in effect
+#define PERLDB_SUB (PL_perldb & PERLDBf_SUB)
+#define PERLDB_LINE (PL_perldb & PERLDBf_LINE)
+#define PERLDB_NOOPT (PL_perldb & PERLDBf_NOOPT)
+#define PERLDB_INTER (PL_perldb & PERLDBf_INTER)
+#define PERLDB_SUBLINE (PL_perldb & PERLDBf_SUBLINE)
+#define PERLDB_SINGLE (PL_perldb & PERLDBf_SINGLE)
+#define PERLDB_SUB_NN (PL_perldb & PERLDBf_NONAME)
+#define PERLDB_GOTO (PL_perldb & PERLDBf_GOTO)
+#define PERLDB_NAMEEVAL (PL_perldb & PERLDBf_NAMEEVAL)
+#define PERLDB_NAMEANON (PL_perldb & PERLDBf_NAMEANON)
+#define PERLDB_SAVESRC (PL_perldb & PERLDBf_SAVESRC)
+#define PERLDB_SAVESRC_NOSUBS (PL_perldb & PERLDBf_SAVESRC_NOSUBS)
+#define PERLDB_SAVESRC_INVALID (PL_perldb & PERLDBf_SAVESRC_INVALID)
+
+#ifdef USE_LOCALE
+/* These locale things are all subject to change */
+/* Returns TRUE if the plain locale pragma without a parameter is in effect
*/
-#define IN_LOCALE_RUNTIME (CopHINTS_get(PL_curcop) & HINT_LOCALE)
+# define IN_LOCALE_RUNTIME cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE)
-/* Returns non-zero If either form of the locale pragma is in effect */
-#define IN_SOME_LOCALE_FORM_RUNTIME \
- (CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS))
+/* Returns TRUE if either form of the locale pragma is in effect */
+# define IN_SOME_LOCALE_FORM_RUNTIME \
+ cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
-#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
-#define IN_SOME_LOCALE_FORM_COMPILETIME \
- (PL_hints & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS))
+# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE)
+# define IN_SOME_LOCALE_FORM_COMPILETIME \
+ cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
-#define IN_LOCALE \
+# define IN_LOCALE \
(IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
-#define IN_SOME_LOCALE_FORM \
+# define IN_SOME_LOCALE_FORM \
(IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \
: IN_SOME_LOCALE_FORM_RUNTIME)
-#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
- bool was_local = PL_numeric_local && IN_LOCALE; \
- if (was_local) SET_NUMERIC_STANDARD();
+# define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME
+# define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME
+
+# define IN_LC_PARTIAL_COMPILETIME cBOOL(PL_hints & HINT_LOCALE_PARTIAL)
+# define IN_LC_PARTIAL_RUNTIME \
+ cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
+
+# define IN_LC_COMPILETIME(category) \
+ (IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME \
+ && _is_in_locale_category(TRUE, (category))))
+# define IN_LC_RUNTIME(category) \
+ (IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \
+ && _is_in_locale_category(FALSE, (category))))
+# define IN_LC(category) \
+ (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category))
+
+# if defined (PERL_CORE) || defined (PERL_IN_XSUB_RE)
+
+ /* This internal macro should be called from places that operate under
+ * locale rules. It there is a problem with the current locale that
+ * hasn't been raised yet, it will output a warning this time. Because
+ * this will so rarely be true, there is no point to optimize for
+ * time; instead it makes sense to minimize space used and do all the
+ * work in the rarely called function */
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE \
+ STMT_START { \
+ if (UNLIKELY(PL_warn_locale)) { \
+ _warn_problematic_locale(); \
+ } \
+ } STMT_END
+
+
+ /* These two internal macros are called when a warning should be raised,
+ * and will do so if enabled. The first takes a single code point
+ * argument; the 2nd, is a pointer to the first byte of the UTF-8 encoded
+ * string, and an end position which it won't try to read past */
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(cp) \
+ Perl_ck_warner(aTHX_ packWARN(WARN_LOCALE), \
+ "Wide character (U+%"UVXf") in %s", (UV) cp, OP_DESC(PL_op));
+
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \
+ STMT_START { /* Check if to warn before doing the conversion work */\
+ if (ckWARN(WARN_LOCALE)) { \
+ UV cp = utf8_to_uvchr_buf((U8 *) s, (U8 *) send, NULL); \
+ Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
+ "Wide character (U+%"UVXf") in %s", \
+ (cp == 0) \
+ ? UNICODE_REPLACEMENT \
+ : (UV) cp, \
+ OP_DESC(PL_op)); \
+ } \
+ } STMT_END
+
+# endif /* PERL_CORE or PERL_IN_XSUB_RE */
+
+#else /* No locale usage */
+# define IN_LOCALE_RUNTIME 0
+# define IN_SOME_LOCALE_FORM_RUNTIME 0
+# define IN_LOCALE_COMPILETIME 0
+# define IN_SOME_LOCALE_FORM_COMPILETIME 0
+# define IN_LOCALE 0
+# define IN_SOME_LOCALE_FORM 0
+# define IN_LC_ALL_COMPILETIME 0
+# define IN_LC_ALL_RUNTIME 0
+# define IN_LC_PARTIAL_COMPILETIME 0
+# define IN_LC_PARTIAL_RUNTIME 0
+# define IN_LC_COMPILETIME(category) 0
+# define IN_LC_RUNTIME(category) 0
+# define IN_LC(category) 0
+
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(a)
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(a,b)
+#endif
+
+#ifdef USE_LOCALE_NUMERIC
-#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
- bool was_standard = PL_numeric_standard && IN_LOCALE; \
- if (was_standard) SET_NUMERIC_LOCAL();
+/* These macros are for toggling between the underlying locale (LOCAL) and the
+ * C locale. */
+
+/* The first set makes sure that the locale is set to C unless within a 'use
+ * locale's scope; otherwise to the default locale. A function pointer is
+ * used, which can be declared separately by
+ * DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED, followed by the actual
+ * setting (using STORE_LC_NUMERIC_SET_TO_NEEDED()), or the two can be combined
+ * into one call DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED().
+ * RESTORE_LC_NUMERIC() in all cases restores the locale to what it was before
+ * these were called */
+
+#define _NOT_IN_NUMERIC_STANDARD (! PL_numeric_standard)
+
+/* We can lock the category to stay in the C locale, making requests to the
+ * contrary noops, in the dynamic scope by setting PL_numeric_standard to 2 */
+#define _NOT_IN_NUMERIC_LOCAL (! PL_numeric_local && PL_numeric_standard < 2)
+
+#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \
+ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL;
+
+#define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ if (IN_LC(LC_NUMERIC)) { \
+ if (_NOT_IN_NUMERIC_LOCAL) { \
+ set_numeric_local(); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
+ } \
+ } \
+ else { \
+ if (_NOT_IN_NUMERIC_STANDARD) { \
+ SET_NUMERIC_STANDARD(); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_local; \
+ } \
+ }
+
+#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; \
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+
+#define RESTORE_LC_NUMERIC() \
+ if (_restore_LC_NUMERIC_function) { \
+ _restore_LC_NUMERIC_function(aTHX); \
+ }
+
+/* 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 { if (_NOT_IN_NUMERIC_STANDARD) set_numeric_standard(); \
+ } STMT_END
+
+#define SET_NUMERIC_LOCAL() \
+ STMT_START { if (_NOT_IN_NUMERIC_LOCAL) \
+ set_numeric_local(); } STMT_END
+
+/* The rest of these LC_NUMERIC macros toggle to one or the other state, with
+ * the RESTORE_foo ones called to switch back, but only if need be */
+#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
+ bool _was_local = _NOT_IN_NUMERIC_STANDARD; \
+ if (_was_local) set_numeric_standard();
+
+/* Doesn't change to underlying locale unless within the scope of some form of
+ * 'use locale'. This is the usual desired behavior. */
+#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
+ bool _was_standard = _NOT_IN_NUMERIC_LOCAL \
+ && IN_LC(LC_NUMERIC); \
+ if (_was_standard) set_numeric_local();
+
+/* Rarely, we want to change to the underlying locale even outside of 'use
+ * locale'. This is principally in the POSIX:: functions */
+#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \
+ bool _was_standard = _NOT_IN_NUMERIC_LOCAL; \
+ if (_was_standard) set_numeric_local();
+
+/* Lock to the C locale until unlock is called */
+#define LOCK_NUMERIC_STANDARD() \
+ (__ASSERT_(PL_numeric_standard) \
+ PL_numeric_standard = 2)
+
+#define UNLOCK_NUMERIC_STANDARD() \
+ (__ASSERT_(PL_numeric_standard == 2) \
+ PL_numeric_standard = 1)
#define RESTORE_NUMERIC_LOCAL() \
- if (was_local) SET_NUMERIC_LOCAL();
+ if (_was_local) set_numeric_local();
#define RESTORE_NUMERIC_STANDARD() \
- if (was_standard) SET_NUMERIC_STANDARD();
+ if (_was_standard) SET_NUMERIC_STANDARD();
#define Atof my_atof
#define IS_NUMERIC_RADIX(a, b) (0)
#define STORE_NUMERIC_LOCAL_SET_STANDARD() /**/
#define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/
+#define STORE_NUMERIC_STANDARD_FORCE_LOCAL()
#define RESTORE_NUMERIC_LOCAL() /**/
#define RESTORE_NUMERIC_STANDARD() /**/
+#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED
+#define STORE_LC_NUMERIC_SET_TO_NEEDED()
+#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED()
+#define RESTORE_LC_NUMERIC()
+#define LOCK_NUMERIC_STANDARD()
+#define UNLOCK_NUMERIC_STANDARD()
+
#define Atof my_atof
-#define IN_LOCALE_RUNTIME 0
-#define IN_LOCALE_COMPILETIME 0
#endif /* !USE_LOCALE_NUMERIC */
+#ifdef USE_QUADMATH
+# define Perl_strtod(s, e) strtoflt128(s, e)
+#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
+# if 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)
+#endif
+
#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \
(QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64)
# ifdef __hpux
# define Atoul(s) Strtoul(s, NULL, 10)
#endif
-
-/* if these never got defined, they need defaults */
-#ifndef PERL_SET_CONTEXT
-# define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i)
-#endif
-
-#ifndef PERL_GET_CONTEXT
-# define PERL_GET_CONTEXT PERL_GET_INTERP
-#endif
-
-#ifndef PERL_GET_THX
-# define PERL_GET_THX ((void*)NULL)
-#endif
-
-#ifndef PERL_SET_THX
-# define PERL_SET_THX(t) NOOP
-#endif
-
#ifndef PERL_SCRIPT_MODE
#define PERL_SCRIPT_MODE "r"
#endif
#ifndef PERL_MICRO
# ifndef PERL_ASYNC_CHECK
-# define PERL_ASYNC_CHECK() if (PL_sig_pending) PL_signalhook(aTHX)
+# define PERL_ASYNC_CHECK() if (UNLIKELY(PL_sig_pending)) PL_signalhook(aTHX)
# endif
#endif
/* Clones the per-interpreter data. */
# define MY_CXT_CLONE \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Copy(PL_my_cxt_list[MY_CXT_INDEX], my_cxtp, 1, my_cxt_t);\
- PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp \
+ void * old_my_cxtp = PL_my_cxt_list[MY_CXT_INDEX]; \
+ PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp; \
+ Copy(old_my_cxtp, my_cxtp, 1, my_cxt_t);
+
/* This macro must be used to access members of the my_cxt_t structure.
#endif
#if O_TEXT != O_BINARY
- /* If you have different O_TEXT and O_BINARY and you are a CLRF shop,
+ /* If you have different O_TEXT and O_BINARY and you are a CRLF shop,
* that is, you are somehow DOSish. */
# if defined(__HAIKU__) || defined(__VOS__) || defined(__CYGWIN__)
/* Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect;
#define IS_NUMBER_NEG 0x08 /* leading minus sign */
#define IS_NUMBER_INFINITY 0x10 /* this is big */
#define IS_NUMBER_NAN 0x20 /* this is not */
+#define IS_NUMBER_TRAILING 0x40 /* number has trailing trash */
#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
#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 */
+#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? */
/* check embedded \0 characters in pathnames passed to syscalls,
but allow one ending \0 */
-#define IS_SAFE_SYSCALL(pv, what, op_name) (S_is_safe_syscall(aTHX_ (pv), (what), (op_name)))
+#define IS_SAFE_SYSCALL(p, len, what, op_name) (S_is_safe_syscall(aTHX_ (p), (len), (what), (op_name)))
-#define IS_SAFE_PATHNAME(pv, op_name) IS_SAFE_SYSCALL((pv), "pathname", (op_name))
+#define IS_SAFE_PATHNAME(p, len, op_name) IS_SAFE_SYSCALL((p), (len), "pathname", (op_name))
#if defined(OEMVS)
#define NO_ENV_ARRAY_IN_MAIN
* passed straight through to _escape.
*/
-#define PERL_PV_ESCAPE_QUOTE 0x0001
+#define PERL_PV_ESCAPE_QUOTE 0x000001
#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
-#define PERL_PV_PRETTY_ELLIPSES 0x0002
-#define PERL_PV_PRETTY_LTGT 0x0004
+#define PERL_PV_PRETTY_ELLIPSES 0x000002
+#define PERL_PV_PRETTY_LTGT 0x000004
+#define PERL_PV_PRETTY_EXACTSIZE 0x000008
-#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
+#define PERL_PV_ESCAPE_UNI 0x000100
+#define PERL_PV_ESCAPE_UNI_DETECT 0x000200
+#define PERL_PV_ESCAPE_NONASCII 0x000400
+#define PERL_PV_ESCAPE_FIRSTCHAR 0x000800
-#define PERL_PV_ESCAPE_UNI 0x0100
-#define PERL_PV_ESCAPE_UNI_DETECT 0x0200
-#define PERL_PV_ESCAPE_NONASCII 0x0400
+#define PERL_PV_ESCAPE_ALL 0x001000
+#define PERL_PV_ESCAPE_NOBACKSLASH 0x002000
+#define PERL_PV_ESCAPE_NOCLEAR 0x004000
+#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
+#define PERL_PV_ESCAPE_RE 0x008000
-#define PERL_PV_ESCAPE_ALL 0x1000
-#define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
-#define PERL_PV_ESCAPE_NOCLEAR 0x4000
-#define PERL_PV_ESCAPE_RE 0x8000
+#define PERL_PV_ESCAPE_DWIM 0x010000
-#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
/* used by pv_display in dump.c*/
#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII
+#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN || \
+ DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN || \
+ DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
+# define DOUBLE_LITTLE_ENDIAN
+#endif
+
+#if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN || \
+ DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN || \
+ DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+# define DOUBLE_BIG_ENDIAN
+#endif
+
+#ifdef LONG_DOUBLEKIND
+
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+# define LONGDOUBLE_LITTLE_ENDIAN
+# endif
+
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+# define LONGDOUBLE_BIG_ENDIAN
+# endif
+
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
+# define LONGDOUBLE_X86_80_BIT
+# endif
+
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+# define LONGDOUBLE_DOUBLEDOUBLE
+# endif
+
+#endif /* LONG_DOUBLEKIND */
+
/*
(KEEP THIS LAST IN perl.h!)
https://perl5.git.perl.org / perl5.git / blobdiff