# include "config.h"
#endif
+/* this is used for functions which take a depth trailing
+ * argument under debugging */
+#ifdef DEBUGGING
+#define _pDEPTH ,U32 depth
+#define _aDEPTH ,depth
+#else
+#define _pDEPTH
+#define _aDEPTH
+#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)
+ defined(_STDC_C99) || defined(__c99)
# define HAS_C99 1
#endif
/* 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)
+#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32)
# define USE_REENTRANT_API
#endif
# endif
#endif
-#ifdef PERL_GLOBAL_STRUCT
-# ifndef PERL_GET_VARS
+#if defined(PERL_GLOBAL_STRUCT) && !defined(PERL_GET_VARS)
# ifdef PERL_GLOBAL_STRUCT_PRIVATE
EXTERN_C struct perl_vars* Perl_GetVarsPrivate();
# define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */
# else
# define PERL_GET_VARS() PL_VarsPtr
# endif
-# endif
#endif
/* this used to be off by default, now its on, see perlio.h */
Perl_pregfree(aTHX_ (prog))
#define CALLREGFREE_PVT(prog) \
- if(prog) RX_ENGINE(prog)->free(aTHX_ (prog))
+ if(prog) RX_ENGINE(prog)->rxfree(aTHX_ (prog))
#define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \
RX_ENGINE(rx)->numbered_buff_FETCH(aTHX_ (rx),(paren),(usesv))
#endif
#ifndef PERL_UNUSED_DECL
-# if defined(HASATTRIBUTE_UNUSED) && (!defined(__cplusplus) || (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)))
+# if defined(HASATTRIBUTE_UNUSED) && (!defined(__cplusplus) || __GNUC__ >= 4)
# define PERL_UNUSED_DECL __attribute__unused__
# else
# define PERL_UNUSED_DECL
* 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)sizeof(x))
-# endif
+# define PERL_UNUSED_ARG(x) ((void)sizeof(x))
#endif
#ifndef PERL_UNUSED_VAR
# define PERL_UNUSED_VAR(x) ((void)sizeof(x))
* 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
+ * one cannot use these with a semicolon 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*
+ * should use the GCC_DIAG_IGNORE and GCC_DIAG_RESTORE macros *without*
* the semicolons.
*
* (A dead-on-arrival solution would be to try to define the macros as
# define GCC_DIAG_IGNORE(w)
# define GCC_DIAG_RESTORE
#endif
+/* for clang specific pragmas */
+#if defined(__clang__) || defined(__clang)
+# define CLANG_DIAG_PRAGMA(x) _Pragma (#x)
+# define CLANG_DIAG_IGNORE(x) _Pragma("clang diagnostic push") \
+ CLANG_DIAG_PRAGMA(clang diagnostic ignored #x)
+# define CLANG_DIAG_RESTORE _Pragma("clang diagnostic pop")
+#else
+# define CLANG_DIAG_IGNORE(w)
+# define CLANG_DIAG_RESTORE
+#endif
#define NOOP /*EMPTY*/(void)0
/* cea2e8a9dd23747f accidentally lost the comment originally from the first
# endif
#endif
-/* Some platforms require marking function declarations
- * for them to be exportable. Used in perlio.h, proto.h
- * is handled either by the makedef.pl or by defining the
- * PERL_CALLCONV to be something special. See also the
- * definition of XS() in XSUB.h. */
-#ifndef PERL_EXPORT_C
-# ifdef __cplusplus
-# define PERL_EXPORT_C extern "C"
-# else
-# define PERL_EXPORT_C extern
-# endif
-#endif
-#ifndef PERL_XS_EXPORT_C
-# ifdef __cplusplus
-# define PERL_XS_EXPORT_C extern "C"
-# else
-# define PERL_XS_EXPORT_C
-# 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 DOSISH 1
#endif
-#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(NETWARE) || defined(__SYMBIAN32__)
-# define STANDARD_C 1
-#endif
-
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
-# define DONT_DECLARE_STD 1
-#endif
-
-#if defined(HASVOLATILE) || defined(STANDARD_C)
-# define VOL volatile
-#else
-# define VOL
+/* These exist only for back-compat with XS modules. */
+#ifndef PERL_CORE
+#define VOL volatile
+#define CAN_PROTOTYPE
+#define _(args) args
+#define I_LIMITS
+#define I_STDARG
+#define STANDARD_C
#endif
/* By compiling a perl with -DNO_TAINT_SUPPORT or -DSILENT_NO_TAINT_SUPPORT,
# define TAINT_WARN_get 0
# define TAINT_WARN_set(s) NOOP
#else
-# define TAINT (PL_tainted = TRUE)
+# define TAINT (PL_tainted = PL_tainting)
# define TAINT_NOT (PL_tainted = FALSE)
-# define TAINT_IF(c) if (UNLIKELY(c)) { PL_tainted = TRUE; }
+# define TAINT_IF(c) if (UNLIKELY(c)) { PL_tainted = PL_tainting; }
# define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); }
# define TAINT_PROPER(s) if (UNLIKELY(PL_tainting)) { taint_proper(NULL, s); }
# define TAINT_set(s) (PL_tainted = (s))
*/
#ifdef HAS_SETPGID
# define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp))
-#else
-# if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
-# define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
-# else
-# ifdef HAS_SETPGRP2 /* DG/UX */
-# define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
-# endif
-# endif
+#elif defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
+# define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
+#elif defined(HAS_SETPGRP2)
+# define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
#endif
#if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
# define HAS_SETPGRP /* Well, effectively it does . . . */
*/
#ifdef HAS_GETPGID
# define BSD_GETPGRP(pid) getpgid((pid))
-#else
-# if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
-# define BSD_GETPGRP(pid) getpgrp((pid))
-# else
-# ifdef HAS_GETPGRP2 /* DG/UX */
-# define BSD_GETPGRP(pid) getpgrp2((pid))
-# endif
-# endif
+#elif defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
+# define BSD_GETPGRP(pid) getpgrp((pid))
+#elif defined(HAS_GETPGRP2)
+# define BSD_GETPGRP(pid) getpgrp2((pid))
#endif
#if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
# define HAS_GETPGRP /* Well, effectively it does . . . */
#include <sys/types.h>
-#ifdef __cplusplus
-# ifndef I_STDARG
-# define I_STDARG 1
-# 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
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
-# ifdef I_VARARGS
-# include <varargs.h>
-# endif
+# define MB_CUR_MAX 1uL
#endif
+# include <stdarg.h>
+
#ifdef I_STDINT
# include <stdint.h>
#endif
#include <ctype.h>
+#include <float.h>
+#include <limits.h>
#ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */
#undef METHOD
# include <locale.h>
#endif
+#ifdef I_XLOCALE
+# include <xlocale.h>
+#endif
+
#if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
# define USE_LOCALE
# define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
# 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
# endif
#endif
-/* Use all the "standard" definitions? */
-#if defined(STANDARD_C) && defined(I_STDLIB)
-# include <stdlib.h>
-#endif
+/* Use all the "standard" definitions */
+#include <stdlib.h>
/* If this causes problems, set i_unistd=undef in the hint file. */
#ifdef I_UNISTD
+# if defined(__amigaos4__)
+# ifdef I_NETINET_IN
+# include <netinet/in.h>
+# endif
+# endif
# include <unistd.h>
+# if defined(__amigaos4__)
+/* Under AmigaOS 4 newlib.library provides an environ. However using
+ * it doesn't give us enough control over inheritance of variables by
+ * subshells etc. so replace with custom version based on abc-shell
+ * code. */
+extern char **myenviron;
+# undef environ
+# define environ myenviron
+# endif
#endif
/* for WCOREDUMP */
#endif /* PERL_CORE */
+/* Maximum number of args that may be passed to an OP_MULTICONCAT op.
+ * It determines the size of local arrays in S_maybe_multiconcat() and
+ * pp_multiconcat().
+ */
+#define PERL_MULTICONCAT_MAXARG 64
+
+/* The indexes of fields of a multiconcat aux struct.
+ * The fixed fields are followed by nargs+1 const segment lengths,
+ * and if utf8 and non-utf8 differ, a second nargs+1 set for utf8.
+ */
+
+#define PERL_MULTICONCAT_IX_NARGS 0 /* number of arguments */
+#define PERL_MULTICONCAT_IX_PLAIN_PV 1 /* non-utf8 constant string */
+#define PERL_MULTICONCAT_IX_PLAIN_LEN 2 /* non-utf8 constant string length */
+#define PERL_MULTICONCAT_IX_UTF8_PV 3 /* utf8 constant string */
+#define PERL_MULTICONCAT_IX_UTF8_LEN 4 /* utf8 constant string length */
+#define PERL_MULTICONCAT_IX_LENGTHS 5 /* first of nargs+1 const segment lens */
+#define PERL_MULTICONCAT_HEADER_SIZE 5 /* The number of fields of a
+ multiconcat header */
+
/* We no longer default to creating a new SV for GvSV.
Do this before embed. */
#ifndef PERL_CREATE_GVSV
# define PERL_STRLEN_EXPAND_SHIFT 2
#endif
-#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
+#include <stddef.h>
+#define STRUCT_OFFSET(s,m) offsetof(s,m)
/* ptrdiff_t is C11, so undef it under pedantic builds */
#ifdef PERL_GCC_PEDANTIC
#endif
#ifndef __SYMBIAN32__
-# if defined(I_STRING) || defined(__cplusplus)
-# include <string.h>
-# else
-# include <strings.h>
-# endif
+# include <string.h>
#endif
/* This comes after <stdlib.h> so we don't try to change the standard
#define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}")
#define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL)
-#if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
-#define strchr index
-#define strrchr rindex
-#endif
-
-#ifdef I_MEMORY
-# include <memory.h>
-#endif
-
-#ifdef HAS_MEMCPY
-# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
-# ifndef memcpy
- extern char * memcpy (char*, char*, int);
-# endif
-# endif
-#else
-# ifndef memcpy
-# ifdef HAS_BCOPY
-# define memcpy(d,s,l) bcopy(s,d,l)
-# else
-# define memcpy(d,s,l) my_bcopy(s,d,l)
-# endif
-# endif
-#endif /* HAS_MEMCPY */
-
-#ifdef HAS_MEMSET
-# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
-# ifndef memset
- extern char *memset (char*, int, int);
-# endif
-# endif
-#else
-# undef memset
-# define memset(d,c,l) my_memset(d,c,l)
-#endif /* HAS_MEMSET */
-
-#if !defined(HAS_MEMMOVE) && !defined(memmove)
-# if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
-# define memmove(d,s,l) bcopy(s,d,l)
-# else
-# if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
-# define memmove(d,s,l) memcpy(d,s,l)
-# else
-# define memmove(d,s,l) my_bcopy(s,d,l)
-# endif
-# endif
-#endif
-
-#if defined(mips) && defined(ultrix) && !defined(__STDC__)
-# undef HAS_MEMCMP
-#endif
-
-#if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
-# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
-# ifndef memcmp
- extern int memcmp (char*, char*, int);
-# endif
-# endif
-#else
-# ifndef memcmp
-# define memcmp my_memcmp
-# endif
-#endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
-
#ifndef memzero
-# ifdef HAS_MEMSET
-# define memzero(d,l) memset(d,0,l)
-# else
-# ifdef HAS_BZERO
-# define memzero(d,l) bzero(d,l)
-# else
-# define memzero(d,l) my_bzero(d,l)
-# endif
-# endif
-#endif
-
-#ifndef PERL_MICRO
-#ifndef memchr
-# ifndef HAS_MEMCHR
-# define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1)
-# endif
-#endif
+# define memzero(d,l) memset(d,0,l)
#endif
-#ifndef HAS_BCMP
-# ifndef bcmp
-# define bcmp(s1,s2,l) memcmp(s1,s2,l)
-# endif
-#endif /* !HAS_BCMP */
-
#ifdef I_NETINET_IN
# include <netinet/in.h>
#endif
# undef S_ISLNK
#endif
-#ifdef I_TIME
-# include <time.h>
-#endif
+#include <time.h>
#ifdef I_SYS_TIME
# ifdef I_SYS_TIME_KERNEL
# include <sys/times.h>
#endif
-#if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
-# undef HAS_STRERROR
-#endif
-
#include <errno.h>
#if defined(WIN32) && defined(PERL_IMPLICIT_SYS)
#if defined(__SUNPRO_CC) /* SUNWspro CC (C++) */
EXTERN_C char *crypt(const char *, const char *);
-EXTERN_C char **environ;
#endif
-#if defined(__cplusplus)
-# if defined(BSDish)
-EXTERN_C char **environ;
-# elif defined(__CYGWIN__)
+#if defined(__cplusplus) && defined(__CYGWIN__)
EXTERN_C char *crypt(const char *, const char *);
#endif
-#endif
#ifdef SETERRNO
# undef SETERRNO /* SOCKS might have defined this */
#define CLEAR_ERRSV() STMT_START { \
SV ** const svp = &GvSV(PL_errgv); \
if (!*svp) { \
- goto clresv_newemptypv; \
+ *svp = newSVpvs(""); \
} else if (SvREADONLY(*svp)) { \
SvREFCNT_dec_NN(*svp); \
- clresv_newemptypv: \
*svp = newSVpvs(""); \
} else { \
SV *const errsv = *svp; \
- sv_setpvs(errsv, ""); \
+ SvPVCLEAR(errsv); \
SvPOK_only(errsv); \
if (SvMAGICAL(errsv)) { \
mg_free(errsv); \
#define UNKNOWN_ERRNO_MSG "(unknown)"
-#ifdef HAS_STRERROR
-# ifndef DONT_DECLARE_STD
-# ifdef VMS
- char *strerror (int,...);
-# else
- char *strerror (int);
-# endif
-# endif
-# ifndef Strerror
-# define Strerror strerror
-# endif
+#if VMS
+#define Strerror(e) strerror((e), vaxc$errno)
#else
-# ifdef HAS_SYS_ERRLIST
- extern int sys_nerr;
- extern char *sys_errlist[];
-# ifndef Strerror
-# define Strerror(e) \
- ((e) < 0 || (e) >= sys_nerr ? UNKNOWN_ERRNO_MSG : sys_errlist[e])
-# endif
-# endif
+#define Strerror(e) strerror(e)
#endif
#ifdef I_SYS_IOCTL
/* Configure already sets Direntry_t */
#if defined(I_DIRENT)
-# include <dirent.h>
-#else
-# ifdef I_SYS_NDIR
-# include <sys/ndir.h>
-# else
-# ifdef I_SYS_DIR
-# ifdef hp9000s500
-# include <ndir.h> /* may be wrong in the future */
-# else
-# include <sys/dir.h>
-# endif
-# endif
-# endif
+# include <dirent.h>
+#elif defined(I_SYS_NDIR)
+# include <sys/ndir.h>
+#elif defined(I_SYS_DIR)
+# include <sys/dir.h>
#endif
/*
#endif
#ifndef S_ISLNK
-# ifdef _S_ISLNK
-# define S_ISLNK(m) _S_ISLNK(m)
-# else
-# ifdef _S_IFLNK
-# define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
-# else
-# ifdef S_IFLNK
-# define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
-# else
-# define S_ISLNK(m) (0)
-# endif
-# endif
-# endif
+# ifdef _S_ISLNK
+# define S_ISLNK(m) _S_ISLNK(m)
+# elif defined(_S_IFLNK)
+# define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
+# elif defined(S_IFLNK)
+# define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
+# else
+# define S_ISLNK(m) (0)
+# endif
#endif
#ifndef S_ISSOCK
-# ifdef _S_ISSOCK
-# define S_ISSOCK(m) _S_ISSOCK(m)
-# else
-# ifdef _S_IFSOCK
-# define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
-# else
-# ifdef S_IFSOCK
-# define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
-# else
-# define S_ISSOCK(m) (0)
-# endif
-# endif
-# endif
+# ifdef _S_ISSOCK
+# define S_ISSOCK(m) _S_ISSOCK(m)
+# elif defined(_S_IFSOCK)
+# define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
+# elif defined(S_IFSOCK)
+# define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
+# else
+# define S_ISSOCK(m) (0)
+# endif
#endif
#ifndef S_IRUSR
#undef UV
#endif
-/* For the times when you want the return value of sprintf, and you want it
- to be the length. Can't have a thread variable passed in, because C89 has
- no varargs macros.
-*/
-#ifdef SPRINTF_RETURNS_STRLEN
-# define my_sprintf sprintf
-#else
-# define my_sprintf Perl_my_sprintf
-#endif
+/* 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). */
+#define my_sprintf sprintf
/*
* If we have v?snprintf() and the C99 variadic macros, we can just
* 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
+#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)
+#elif 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, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; })
# define PERL_MY_SNPRINTF_GUARDED
# 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. */
# define my_strlcat Perl_my_strlcat
#endif
+#if defined(PERL_CORE) || defined(PERL_EXT)
+# ifdef HAS_MEMRCHR
+# define my_memrchr memrchr
+# else
+# define my_memrchr S_my_memrchr
+# endif
+#endif
+
#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
+
/*
The IV type is supposed to be long enough to hold any integral
value or a pointer.
#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
# define PTRV UV
# define INT2PTR(any,d) (any)(d)
+#elif PTRSIZE == LONGSIZE
+# define PTRV unsigned long
+# define PTR2ul(p) (unsigned long)(p)
#else
-# if PTRSIZE == LONGSIZE
-# define PTRV unsigned long
-# define PTR2ul(p) (unsigned long)(p)
-# else
-# define PTRV unsigned
-# endif
+# define PTRV unsigned
#endif
#ifndef INT2PTR
# endif
#endif
-#ifdef OVR_DBL_DIG
-/* Use an overridden DBL_DIG */
-# ifdef DBL_DIG
-# undef DBL_DIG
-# endif
-# define DBL_DIG OVR_DBL_DIG
-#else
-/* The following is all to get DBL_DIG, in order to pick a nice
- default value for printing floating point numbers in Gconvert
- (see config.h). (It also has other uses, such as figuring out if
- a given precision of printing can be done with a double instead of
- a long double - Allen).
-*/
-#ifdef I_LIMITS
-#include <limits.h>
-#endif
-#ifdef I_FLOAT
-#include <float.h>
-#endif
-#ifndef HAS_DBL_DIG
-#define DBL_DIG 15 /* A guess that works lots of places */
-#endif
-#endif
-
-#ifdef OVR_LDBL_DIG
-/* Use an overridden LDBL_DIG */
-# ifdef LDBL_DIG
-# undef LDBL_DIG
-# endif
-# define LDBL_DIG OVR_LDBL_DIG
-#else
/* The following is all to get LDBL_DIG, in order to pick a nice
default value for printing floating point numbers in Gconvert.
(see config.h)
*/
-# ifdef I_LIMITS
-# include <limits.h>
-# endif
-# ifdef I_FLOAT
-# include <float.h>
-# endif
-# ifndef HAS_LDBL_DIG
+#ifndef HAS_LDBL_DIG
# if LONG_DOUBLESIZE == 10
-# define LDBL_DIG 18 /* assume IEEE */
-# else
-# if LONG_DOUBLESIZE == 12
+# define LDBL_DIG 18 /* assume IEEE */
+# elif LONG_DOUBLESIZE == 12
# define LDBL_DIG 18 /* gcc? */
-# else
-# if LONG_DOUBLESIZE == 16
-# define LDBL_DIG 33 /* assume IEEE */
-# else
-# if LONG_DOUBLESIZE == DOUBLESIZE
-# define LDBL_DIG DBL_DIG /* bummer */
-# endif
-# endif
-# endif
+# elif LONG_DOUBLESIZE == 16
+# define LDBL_DIG 33 /* assume IEEE */
+# elif LONG_DOUBLESIZE == DOUBLESIZE
+# define LDBL_DIG DBL_DIG /* bummer */
# endif
-# endif
-#endif
-
-/*
- * This is for making sure we have a good DBL_MAX value, if possible,
- * either for usage as NV_MAX or for usage in figuring out if we can
- * fit a given long double into a double, if bug-fixing makes it
- * necessary to do so. - Allen <allens@cpan.org>
- */
-
-#ifdef I_LIMITS
-# include <limits.h>
#endif
-#ifdef I_VALUES
-# if !(defined(DBL_MIN) && defined(DBL_MAX) && defined(I_LIMITS))
-# include <values.h>
-# if defined(MAXDOUBLE) && !defined(DBL_MAX)
-# define DBL_MAX MAXDOUBLE
-# endif
-# if defined(MINDOUBLE) && !defined(DBL_MIN)
-# define DBL_MIN MINDOUBLE
-# endif
-# endif
-#endif /* defined(I_VALUES) */
-
typedef NVTYPE NV;
#ifdef I_IEEEFP
/* Also Tru64 cc has broken NaN comparisons. */
# define NAN_COMPARE_BROKEN
#endif
+#if defined(__sgi)
+# define NAN_COMPARE_BROKEN
+#endif
#ifdef USE_LONG_DOUBLE
# ifdef I_SUNMATH
# 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
-# endif
+# elif defined(HUGE_VALL)
+# define NV_MAX HUGE_VALL
# endif
# endif
# if defined(HAS_SQRTL)
# ifndef Perl_frexp
# ifdef HAS_FREXPL
# define Perl_frexp(x,y) frexpl(x,y)
-# else
-# if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
+# elif 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
+# define Perl_frexp(x,y) Perl_my_frexpl(x,y)
# 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
+# elif defined(HAS_SCALBNL) && FLT_RADIX == 2
+# define Perl_ldexp(x,y) scalbnl(x,y)
# endif
# endif
# ifndef Perl_isnan
# if defined(HAS_ISNANL) && !(defined(isnan) && defined(HAS_C99))
# define Perl_isnan(x) isnanl(x)
+# elif defined(__sgi) && defined(__c99) /* XXX Configure test needed */
+# define Perl_isnan(x) isnan(x)
# endif
# endif
# ifndef Perl_isinf
# if defined(HAS_ISINFL) && !(defined(isinf) && defined(HAS_C99))
# define Perl_isinf(x) isinfl(x)
+# elif defined(__sgi) && defined(__c99) /* XXX Configure test needed */
+# define Perl_isinf(x) isinf(x)
# elif defined(LDBL_MAX) && !defined(NAN_COMPARE_BROKEN)
# define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX)
# endif
# 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_isinf(x) isinfq(x)
# define Perl_isnan(x) isnanq(x)
# define Perl_isfinite(x) !(isnanq(x) || isinfq(x))
+# define Perl_fp_class(x) ((x) == 0.0Q ? 0 : isinfq(x) ? 3 : isnanq(x) ? 4 : PERL_ABS(x) < FLT128_MIN ? 2 : 1)
+# define Perl_fp_class_inf(x) (Perl_fp_class(x) == 3)
+# define Perl_fp_class_nan(x) (Perl_fp_class(x) == 4)
+# define Perl_fp_class_norm(x) (Perl_fp_class(x) == 1)
+# define Perl_fp_class_denorm(x) (Perl_fp_class(x) == 2)
+# define Perl_fp_class_zero(x) (Perl_fp_class(x) == 0)
#else
# define NV_DIG DBL_DIG
-# ifdef DBL_MANT_DIG
-# define NV_MANT_DIG DBL_MANT_DIG
-# endif
-# ifdef DBL_MIN
-# define NV_MIN DBL_MIN
-# endif
-# 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
-# ifdef DBL_MAX_10_EXP
-# define NV_MAX_10_EXP DBL_MAX_10_EXP
-# endif
-# ifdef DBL_EPSILON
-# define NV_EPSILON DBL_EPSILON
-# endif
-# ifdef DBL_MAX /* XXX Does DBL_MAX imply having DBL_MIN? */
-# define NV_MAX DBL_MAX
-# define NV_MIN DBL_MIN
-# else
-# ifdef HUGE_VAL
-# define NV_MAX HUGE_VAL
-# endif
-# endif
+# define NV_MANT_DIG DBL_MANT_DIG
+# define NV_MIN DBL_MIN
+# define NV_MAX DBL_MAX
+# define NV_MIN_EXP DBL_MIN_EXP
+# define NV_MAX_EXP DBL_MAX_EXP
+# define NV_MIN_10_EXP DBL_MIN_10_EXP
+# define NV_MAX_10_EXP DBL_MAX_10_EXP
+# define NV_EPSILON DBL_EPSILON
+# define NV_MAX DBL_MAX
+# define NV_MIN DBL_MIN
/* These math interfaces are C89. */
# define Perl_acos acos
/* 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 */
+# if defined(__sun) || defined(__sgi) /* XXX Configure test instead */
# define FP_PINF FP_PINF
# define FP_QNAN FP_QNAN
# endif
# include <fp_class.h>
# endif
# if defined(FP_POS_INF) && defined(FP_QNAN)
-# ifdef __irix__ /* XXX Configure test instead */
+# ifdef __sgi /* XXX Configure test instead */
# ifdef USE_LONG_DOUBLE
# define Perl_fp_class(x) fp_class_l(x)
# else
#ifndef Perl_isnan
# ifdef Perl_fp_class_nan
# define Perl_isnan(x) Perl_fp_class_nan(x)
+# elif defined(HAS_UNORDERED)
+# define Perl_isnan(x) unordered((x), 0.0)
# else
-# ifdef HAS_UNORDERED
-# define Perl_isnan(x) unordered((x), 0.0)
-# else
-# define Perl_isnan(x) ((x)!=(x))
-# endif
+# define Perl_isnan(x) ((x)!=(x))
# endif
#endif
# define Perl_atof2(s, n) ((n) = atof(s))
#endif
-/* Previously these definitions used hardcoded figures.
- * It is hoped these formula are more portable, although
- * no data one way or another is presently known to me.
- * The "PERL_" names are used because these calculated constants
- * do not meet the ANSI requirements for LONG_MAX, etc., which
- * need to be constants acceptable to #if - kja
- * define PERL_LONG_MAX 2147483647L
- * define PERL_LONG_MIN (-LONG_MAX - 1)
- * define PERL ULONG_MAX 4294967295L
- */
-
-#ifdef I_LIMITS /* Needed for cast_xxx() functions below. */
-# include <limits.h>
-#endif
-/* Included values.h above if necessary; still including limits.h down here,
- * despite doing above, because math.h might have overridden... XXX - Allen */
-
-/*
- * Try to figure out max and min values for the integral types. THE CORRECT
- * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE. The
- * following hacks are used if neither limits.h or values.h provide them:
- * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0
- * for types < int: (unsigned TYPE)~(unsigned)0
- * The argument to ~ must be unsigned so that later signed->unsigned
- * conversion can't modify the value's bit pattern (e.g. -0 -> +0),
- * and it must not be smaller than int because ~ does integral promotion.
- * <type>_MAX: (<type>) (U<type>_MAX >> 1)
- * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>.
- * The latter is a hack which happens to work on some machines but
- * does *not* catch any random system, or things like integer types
- * with NaN if that is possible.
- *
- * All of the types are explicitly cast to prevent accidental loss of
- * numeric range, and in the hope that they will be less likely to confuse
- * over-eager optimizers.
- *
- */
-
-#define PERL_UCHAR_MIN ((unsigned char)0)
-
-#ifdef UCHAR_MAX
-# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
-#else
-# ifdef MAXUCHAR
-# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
-# else
-# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
-# endif
-#endif
-
/*
* CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be
* ambiguous. It may be equivalent to (signed char) or (unsigned char)
* - kja
*/
-#define PERL_USHORT_MIN ((unsigned short)0)
-
-#ifdef USHORT_MAX
-# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
-#else
-# ifdef MAXUSHORT
-# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
-# else
-# ifdef USHRT_MAX
-# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
-# else
-# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
-# endif
-# endif
-#endif
-
-#ifdef SHORT_MAX
-# define PERL_SHORT_MAX ((short)SHORT_MAX)
-#else
-# ifdef MAXSHORT /* Often used in <values.h> */
-# define PERL_SHORT_MAX ((short)MAXSHORT)
-# else
-# ifdef SHRT_MAX
-# define PERL_SHORT_MAX ((short)SHRT_MAX)
-# else
-# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
-# endif
-# endif
-#endif
+#define PERL_UCHAR_MIN ((unsigned char)0)
+#define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
-#ifdef SHORT_MIN
-# define PERL_SHORT_MIN ((short)SHORT_MIN)
-#else
-# ifdef MINSHORT
-# define PERL_SHORT_MIN ((short)MINSHORT)
-# else
-# ifdef SHRT_MIN
-# define PERL_SHORT_MIN ((short)SHRT_MIN)
-# else
-# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
-# endif
-# endif
-#endif
+#define PERL_USHORT_MIN ((unsigned short)0)
+#define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
-#ifdef UINT_MAX
-# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
-#else
-# ifdef MAXUINT
-# define PERL_UINT_MAX ((unsigned int)MAXUINT)
-# else
-# define PERL_UINT_MAX (~(unsigned int)0)
-# endif
-#endif
+#define PERL_SHORT_MAX ((short)SHRT_MAX)
+#define PERL_SHORT_MIN ((short)SHRT_MIN)
+#define PERL_UINT_MAX ((unsigned int)UINT_MAX)
#define PERL_UINT_MIN ((unsigned int)0)
-#ifdef INT_MAX
-# define PERL_INT_MAX ((int)INT_MAX)
-#else
-# ifdef MAXINT /* Often used in <values.h> */
-# define PERL_INT_MAX ((int)MAXINT)
-# else
-# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
-# endif
-#endif
+#define PERL_INT_MAX ((int)INT_MAX)
+#define PERL_INT_MIN ((int)INT_MIN)
-#ifdef INT_MIN
-# define PERL_INT_MIN ((int)INT_MIN)
-#else
-# ifdef MININT
-# define PERL_INT_MIN ((int)MININT)
-# else
-# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
-# endif
-#endif
+#define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
+#define PERL_ULONG_MIN ((unsigned long)0L)
-#ifdef ULONG_MAX
-# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
-#else
-# ifdef MAXULONG
-# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
-# else
-# define PERL_ULONG_MAX (~(unsigned long)0)
-# endif
+#define PERL_LONG_MAX ((long)LONG_MAX)
+#define PERL_LONG_MIN ((long)LONG_MIN)
+
+#ifdef UV_IS_QUAD
+# define PERL_UQUAD_MAX (~(UV)0)
+# define PERL_UQUAD_MIN ((UV)0)
+# define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1))
+# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
#endif
-#define PERL_ULONG_MIN ((unsigned long)0L)
-
-#ifdef LONG_MAX
-# define PERL_LONG_MAX ((long)LONG_MAX)
-#else
-# ifdef MAXLONG /* Often used in <values.h> */
-# define PERL_LONG_MAX ((long)MAXLONG)
-# else
-# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
-# endif
-#endif
-
-#ifdef LONG_MIN
-# define PERL_LONG_MIN ((long)LONG_MIN)
-#else
-# ifdef MINLONG
-# define PERL_LONG_MIN ((long)MINLONG)
-# else
-# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
-# endif
-#endif
-
-#ifdef UV_IS_QUAD
-
-# define PERL_UQUAD_MAX (~(UV)0)
-# define PERL_UQUAD_MIN ((UV)0)
-# define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1))
-# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
-
-#endif
-
-typedef MEM_SIZE STRLEN;
+typedef MEM_SIZE STRLEN;
typedef struct op OP;
typedef struct cop COP;
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_NEW_COPY_ON_WRITE
+/* enable PERL_OP_PARENT by default */
+#if !defined(PERL_OP_PARENT) && !defined(PERL_NO_OP_PARENT)
+# define PERL_OP_PARENT
#endif
-#if defined(PERL_OLD_COPY_ON_WRITE) || defined(PERL_NEW_COPY_ON_WRITE)
-# if defined(PERL_OLD_COPY_ON_WRITE) && defined(PERL_NEW_COPY_ON_WRITE)
-# error PERL_OLD_COPY_ON_WRITE and PERL_NEW_COPY_ON_WRITE are exclusive
-# else
+/* enable PERL_COPY_ON_WRITE by default */
+#if !defined(PERL_COPY_ON_WRITE) && !defined(PERL_NO_COW)
+# define PERL_COPY_ON_WRITE
+#endif
+
+#ifdef PERL_COPY_ON_WRITE
# define PERL_ANY_COW
-# endif
#else
# define PERL_SAWAMPERSAND
#endif
#endif
#include "handy.h"
+#include "charclass_invlists.h"
#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
# if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO)
# include "unixish.h"
#endif
+#ifdef __amigaos4__
+# include "amigaos.h"
+# undef FD_CLOEXEC /* a lie in AmigaOS */
+#endif
+
/* NSIG logic from Configure --> */
-/* Strange style to avoid deeply-nested #if/#else/#endif */
#ifndef NSIG
# ifdef _NSIG
# define NSIG (_NSIG)
-# endif
-#endif
-
-#ifndef NSIG
-# ifdef SIGMAX
+# elif defined(SIGMAX)
# define NSIG (SIGMAX+1)
-# endif
-#endif
-
-#ifndef NSIG
-# ifdef SIG_MAX
+# elif defined(SIG_MAX)
# define NSIG (SIG_MAX+1)
-# endif
-#endif
-
-#ifndef NSIG
-# ifdef _SIG_MAX
+# elif defined(_SIG_MAX)
# define NSIG (_SIG_MAX+1)
-# endif
-#endif
-
-#ifndef NSIG
-# ifdef MAXSIG
+# elif defined(MAXSIG)
# define NSIG (MAXSIG+1)
-# endif
-#endif
-
-#ifndef NSIG
-# ifdef MAX_SIG
+# elif defined(MAX_SIG)
# define NSIG (MAX_SIG+1)
-# endif
-#endif
-
-#ifndef NSIG
-# ifdef SIGARRAYSIZE
+# elif defined(SIGARRAYSIZE)
# define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */
-# endif
-#endif
-
-#ifndef NSIG
-# ifdef _sys_nsig
+# elif defined(_sys_nsig)
# define NSIG (_sys_nsig) /* Solaris 2.5 */
-# endif
-#endif
-
-/* Default to some arbitrary number that's big enough to get most
- of the common signals.
-*/
-#ifndef NSIG
+# else
+ /* Default to some arbitrary number that's big enough to get most
+ * of the common signals. */
# define NSIG 50
+# endif
#endif
/* <-- NSIG logic from Configure */
and then they have the gall to warn that a value computed is not used. Hence
cast to void. */
# define PERL_FPU_INIT (void)fpsetmask(0)
+# elif defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
+# define PERL_FPU_INIT PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN)
+# define PERL_FPU_PRE_EXEC { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
+# define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); }
# else
-# if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
-# define PERL_FPU_INIT PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN)
-# define PERL_FPU_PRE_EXEC { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
-# define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); }
-# else
-# define PERL_FPU_INIT
-
-# endif
+# define PERL_FPU_INIT
# endif
#endif
#ifndef PERL_FPU_PRE_EXEC
signal(SIGFPE, SIG_IGN); \
} STMT_END
#endif
+/* In IRIX the default for Flush to Zero bit is true,
+ * which means that results going below the minimum of normal
+ * floating points go to zero, instead of going denormal/subnormal.
+ * This is unlike almost any other system running Perl, so let's clear it.
+ * [perl #123767] IRIX64 blead (ddce084a) opbasic/arith.t failure, originally
+ * [perl #120426] small numbers shouldn't round to zero if they have extra floating digits
+ *
+ * XXX The flush-to-zero behaviour should be a Configure scan.
+ * To change the behaviour usually requires some system-specific
+ * incantation, though, like the below. */
+#ifdef __sgi
+# include <sys/fpu.h>
+# define PERL_SYS_FPU_INIT \
+ STMT_START { \
+ union fpc_csr csr; \
+ csr.fc_word = get_fpc_csr(); \
+ csr.fc_struct.flush = 0; \
+ set_fpc_csr(csr.fc_word); \
+ } STMT_END
+#endif
#ifndef PERL_SYS_FPU_INIT
# define PERL_SYS_FPU_INIT NOOP
* May make sense to have threads after "*ish.h" anyway
*/
+/* clang Thread Safety Analysis/Annotations/Attributes
+ * http://clang.llvm.org/docs/ThreadSafetyAnalysis.html
+ *
+ * Available since clang 3.6-ish (appeared in 3.4, but shaky still in 3.5).
+ * Apple XCode hijacks __clang_major__ and __clang_minor__
+ * (6.1 means really clang 3.6), so needs extra hijinks
+ * (could probably also test the contents of __apple_build_version__).
+ */
+#if defined(USE_ITHREADS) && defined(I_PTHREAD) && \
+ defined(__clang__) && \
+ !defined(PERL_GLOBAL_STRUCT) && \
+ !defined(PERL_GLOBAL_STRUCT_PRIVATE) && \
+ !defined(SWIG) && \
+ ((!defined(__apple_build_version__) && \
+ ((__clang_major__ == 3 && __clang_minor__ >= 6) || \
+ (__clang_major__ >= 4))) || \
+ (defined(__apple_build_version__) && \
+ ((__clang_major__ == 6 && __clang_minor__ >= 1) || \
+ (__clang_major__ >= 7))))
+# define PERL_TSA__(x) __attribute__((x))
+# define PERL_TSA_ACTIVE
+#else
+# define PERL_TSA__(x) /* No TSA, make TSA attributes no-ops. */
+# undef PERL_TSA_ACTIVE
+#endif
+
+/* PERL_TSA_CAPABILITY() is used to annotate typedefs.
+ * typedef old_type PERL_TSA_CAPABILITY("mutex") new_type;
+ */
+#define PERL_TSA_CAPABILITY(x) \
+ PERL_TSA__(capability(x))
+
+/* In the below examples the mutex must be lexically visible, usually
+ * either as global variables, or as function arguments. */
+
+/* PERL_TSA_GUARDED_BY() is used to annotate global variables.
+ *
+ * Foo foo PERL_TSA_GUARDED_BY(mutex);
+ */
+#define PERL_TSA_GUARDED_BY(x) \
+ PERL_TSA__(guarded_by(x))
+
+/* PERL_TSA_PT_GUARDED_BY() is used to annotate global pointers.
+ * The data _behind_ the pointer is guarded.
+ *
+ * Foo* ptr PERL_TSA_PT_GUARDED_BY(mutex);
+ */
+#define PERL_TSA_PT_GUARDED_BY(x) \
+ PERL_TSA__(pt_guarded_by(x))
+
+/* PERL_TSA_REQUIRES() is used to annotate functions.
+ * The caller MUST hold the resource when calling the function.
+ *
+ * void Foo() PERL_TSA_REQUIRES(mutex);
+ */
+#define PERL_TSA_REQUIRES(x) \
+ PERL_TSA__(requires_capability(x))
+
+/* PERL_TSA_EXCLUDES() is used to annotate functions.
+ * The caller MUST NOT hold resource when calling the function.
+ *
+ * EXCLUDES should be used when the function first acquires
+ * the resource and then releases it. Use to avoid deadlock.
+ *
+ * void Foo() PERL_TSA_EXCLUDES(mutex);
+ */
+#define PERL_TSA_EXCLUDES(x) \
+ PERL_TSA__(locks_excluded(x))
+
+/* PERL_TSA_ACQUIRE() is used to annotate functions.
+ * The caller MUST NOT hold the resource when calling the function,
+ * and the function will acquire the resource.
+ *
+ * void Foo() PERL_TSA_ACQUIRE(mutex);
+ */
+#define PERL_TSA_ACQUIRE(x) \
+ PERL_TSA__(acquire_capability(x))
+
+/* PERL_TSA_RELEASE() is used to annotate functions.
+ * The caller MUST hold the resource when calling the function,
+ * and the function will release the resource.
+ *
+ * void Foo() PERL_TSA_RELEASE(mutex);
+ */
+#define PERL_TSA_RELEASE(x) \
+ PERL_TSA__(release_capability(x))
+
+/* PERL_TSA_NO_TSA is used to annotate functions.
+ * Used when being intentionally unsafe, or when the code is too
+ * complicated for the analysis. Use sparingly.
+ *
+ * void Foo() PERL_TSA_NO_TSA;
+ */
+#define PERL_TSA_NO_TSA \
+ PERL_TSA__(no_thread_safety_analysis)
+
+/* There are more annotations/attributes available, see the clang
+ * documentation for details. */
+
#if defined(USE_ITHREADS)
# ifdef NETWARE
-# include <nw5thread.h>
-# else
-# ifdef WIN32
-# include <win32thread.h>
-# else
-# ifdef OS2
-# include "os2thread.h"
-# else
-# ifdef I_MACH_CTHREADS
-# include <mach/cthreads.h>
+# include <nw5thread.h>
+# elif defined(WIN32)
+# include <win32thread.h>
+# elif defined(OS2)
+# include "os2thread.h"
+# elif defined(I_MACH_CTHREADS)
+# include <mach/cthreads.h>
typedef cthread_t perl_os_thread;
typedef mutex_t perl_mutex;
typedef condition_t perl_cond;
typedef void * perl_key;
-# else /* Posix threads */
-# ifdef I_PTHREAD
-# include <pthread.h>
-# endif
+# elif defined(I_PTHREAD) /* Posix threads */
+# include <pthread.h>
typedef pthread_t perl_os_thread;
-typedef pthread_mutex_t perl_mutex;
+typedef pthread_mutex_t PERL_TSA_CAPABILITY("mutex") perl_mutex;
typedef pthread_cond_t perl_cond;
typedef pthread_key_t perl_key;
-# endif /* I_MACH_CTHREADS */
-# endif /* OS2 */
-# endif /* WIN32 */
-# endif /* NETWARE */
+# endif
#endif /* USE_ITHREADS */
+#ifdef PERL_TSA_ACTIVE
+/* Since most pthread mutex interfaces have not been annotated, we
+ * need to have these wrappers. The NO_TSA annotation is quite ugly
+ * but it cannot be avoided in plain C, unlike in C++, where one could
+ * e.g. use ACQUIRE() with no arg on a mutex lock method.
+ *
+ * The bodies of these wrappers are in util.c
+ *
+ * TODO: however, some platforms are starting to get these clang
+ * thread safety annotations for pthreads, for example FreeBSD.
+ * Do we need a way to a bypass these wrappers? */
+EXTERN_C int perl_tsa_mutex_lock(perl_mutex* mutex)
+ PERL_TSA_ACQUIRE(*mutex)
+ PERL_TSA_NO_TSA;
+EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex)
+ PERL_TSA_RELEASE(*mutex)
+ PERL_TSA_NO_TSA;
+#endif
+
#if defined(WIN32)
# include "win32.h"
#endif
vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \
(C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT)
+#elif defined(__amigaos4__)
+ /* A somewhat experimental attempt to simulate posix return code values */
+# define STATUS_NATIVE PL_statusvalue_posix
+# define STATUS_NATIVE_CHILD_SET(n) \
+ STMT_START { \
+ PL_statusvalue_posix = (n); \
+ if (PL_statusvalue_posix < 0) { \
+ PL_statusvalue = -1; \
+ } \
+ else { \
+ PL_statusvalue = n << 8; \
+ } \
+ } STMT_END
+# define STATUS_UNIX_SET(n) \
+ STMT_START { \
+ PL_statusvalue = (n); \
+ if (PL_statusvalue != -1) \
+ PL_statusvalue &= 0xFFFF; \
+ } STMT_END
+# define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n)
+# define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n)
+# define STATUS_CURRENT STATUS_UNIX
+# define STATUS_EXIT STATUS_UNIX
+# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0)
+# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1)
+
#else
# define STATUS_NATIVE PL_statusvalue_posix
# if defined(WCOREDUMP)
#ifndef PERL_FLUSHALL_FOR_CHILD
# if defined(USE_PERLIO) || defined(FFLUSH_NULL)
# define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL)
+# elif defined(FFLUSH_ALL)
+# define PERL_FLUSHALL_FOR_CHILD my_fflush_all()
# else
-# ifdef FFLUSH_ALL
-# define PERL_FLUSHALL_FOR_CHILD my_fflush_all()
-# else
-# define PERL_FLUSHALL_FOR_CHILD NOOP
-# endif
+# define PERL_FLUSHALL_FOR_CHILD NOOP
# endif
#endif
#ifdef PERL_CORE
/* not used; but needed for backward compatibility with XS code? - RMB */
# undef UVf
-#else
-# ifndef UVf
-# define UVf UVuf
-# endif
+#elif !defined(UVf)
+# define UVf UVuf
#endif
#ifdef HASATTRIBUTE_DEPRECATED
# define __attribute__warn_unused_result__
#endif
-#ifdef I_ASSERT
-# if !defined(DEBUGGING) && !defined(NDEBUG)
-# define NDEBUG 1
-# endif
-# include <assert.h>
+#if !defined(DEBUGGING) && !defined(NDEBUG)
+# define NDEBUG 1
#endif
+#include <assert.h>
/* 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 NOT_REACHED; /* NOTREACHED */
+# define NORETURN_FUNCTION_END NOT_REACHED;
#else
-# define NORETURN_FUNCTION_END NOT_REACHED; /* NOTREACHED */ return 0
+# define NORETURN_FUNCTION_END NOT_REACHED; return 0
#endif
/* Some OS warn on NULL format to printf */
/* placeholder */
#endif
+/* STATIC_ASSERT_DECL/STATIC_ASSERT_STMT are like assert(), but for compile
+ time invariants. That is, their argument must be a constant expression that
+ can be verified by the compiler. This expression can contain anything that's
+ known to the compiler, e.g. #define constants, enums, or sizeof (...). If
+ the expression evaluates to 0, compilation fails.
+ Because they generate no runtime code (i.e. their use is "free"), they're
+ always active, even under non-DEBUGGING builds.
+ STATIC_ASSERT_DECL expands to a declaration and is suitable for use at
+ file scope (outside of any function).
+ STATIC_ASSERT_STMT expands to a statement and is suitable for use inside a
+ function.
+*/
#if (defined(static_assert) || (defined(__cplusplus) && __cplusplus >= 201103L)) && (!defined(__IBMC__) || __IBMC__ >= 1210)
/* static_assert is a macro defined in <assert.h> in C11 or a compiler
- builtin in C++11.
+ builtin in C++11. But IBM XL C V11 does not support _Static_assert, no
+ matter what <assert.h> says.
*/
-/* IBM XL C V11 does not support _Static_assert, no matter what <assert.h> says */
-# define STATIC_ASSERT_GLOBAL(COND) static_assert(COND, #COND)
+# define STATIC_ASSERT_DECL(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.
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__)
+# define STATIC_ASSERT_DECL(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)
+#define STATIC_ASSERT_STMT(COND) STMT_START { STATIC_ASSERT_DECL(COND); } STMT_END
#ifndef __has_builtin
# define __has_builtin(x) 0 /* not a clang style compiler */
# define ASSUME(x) assert(x)
#endif
-#define NOT_REACHED ASSUME(0)
+#if defined(__sun) /* ASSUME() generates warnings on Solaris */
+# define NOT_REACHED
+#elif defined(DEBUGGING) && (__has_builtin(__builtin_unreachable) \
+ || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4)) /* 4.5 -> */
+# define NOT_REACHED STMT_START { ASSUME(0); __builtin_unreachable(); } STMT_END
+#else
+# define NOT_REACHED ASSUME(0)
+#endif
/* Some unistd.h's give a prototype for pause() even though
HAS_PAUSE ends up undefined. This causes the #define
# ifdef IOCPARM_MASK
/* on BSDish systems we're safe */
# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK)
-# else
-# if defined(_IOC_SIZE) && defined(__GLIBC__)
+# elif defined(_IOC_SIZE) && defined(__GLIBC__)
/* on Linux systems we're safe; except when we're not [perl #38223] */
-# define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x))
-# else
+# define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x))
+# else
/* otherwise guess at what's safe */
-# define IOCPARM_LEN(x) 256
-# endif
+# define IOCPARM_LEN(x) 256
# endif
#endif
# define USEMYBINMODE /**/
# include <io.h> /* for setmode() prototype */
# define my_binmode(fp, iotype, mode) \
- (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE)
+ cBOOL(PerlLIO_setmode(fileno(fp), mode) != -1)
#endif
#ifdef __CYGWIN__
#else
union any {
void* any_ptr;
+ SV* any_sv;
+ SV** any_svp;
+ GV* any_gv;
+ AV* any_av;
+ HV* any_hv;
+ OP* any_op;
+ char* any_pv;
+ char** any_pvp;
I32 any_i32;
U32 any_u32;
IV any_iv;
#endif /* threading */
#endif /* AIX */
+#ifndef PERL_CALLCONV
+# ifdef __cplusplus
+# define PERL_CALLCONV extern "C"
+# else
+# define PERL_CALLCONV
+# endif
+#endif
+#ifndef PERL_CALLCONV_NO_RET
+# define PERL_CALLCONV_NO_RET PERL_CALLCONV
+#endif
+
+/* PERL_STATIC_NO_RET is supposed to be equivalent to STATIC on builds that
+ dont have a noreturn as a declaration specifier
+*/
+#ifndef PERL_STATIC_NO_RET
+# define PERL_STATIC_NO_RET STATIC
+#endif
+/* PERL_STATIC_NO_RET is supposed to be equivalent to PERL_STATIC_INLINE on
+ builds that dont have a noreturn as a declaration specifier
+*/
+#ifndef PERL_STATIC_INLINE_NO_RET
+# define PERL_STATIC_INLINE_NO_RET PERL_STATIC_INLINE
+#endif
+
#if !defined(OS2)
# include "iperlsys.h"
#endif
#endif
/* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0.
- * Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT*
- * defined by Configure, despite their names being similar to the
- * other defines like USE_ITHREADS. Configure in fact knows nothing
- * about the randomised hashes. Therefore to enable/disable the hash
- * randomisation defines use the Configure -Accflags=... instead. */
-#if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT)
+ * Note that the USE_HASH_SEED and similar defines are *NOT* defined by
+ * Configure, despite their names being similar to other defines like
+ * USE_ITHREADS. Configure in fact knows nothing about the randomised
+ * hashes. Therefore to enable/disable the hash randomisation defines
+ * use the Configure -Accflags=... instead. */
+#if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED)
# define USE_HASH_SEED
#endif
-/* Win32 defines a type 'WORD' in windef.h. This conflicts with the enumerator
- * 'WORD' defined in perly.h. The yytokentype enum is only a debugging aid, so
- * it's not really needed.
- */
-#if defined(WIN32)
-# define YYTOKENTYPE
-#endif
#include "perly.h"
#undef _XPVMG_HEAD
#undef _XPVCV_COMMON
-typedef struct _sublex_info SUBLEXINFO;
-struct _sublex_info {
- U8 super_state; /* lexer state to save */
- U16 sub_inwhat; /* "lex_inwhat" to use */
- OP *sub_op; /* "lex_op" to use */
- SV *repl; /* replacement of s/// or y/// */
-};
-
#include "parser.h"
typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
#define DEBUG_u_FLAG 0x00000800 /* 2048 */
/* U is reserved for Unofficial, exploratory hacking */
#define DEBUG_U_FLAG 0x00001000 /* 4096 */
-#define DEBUG_H_FLAG 0x00002000 /* 8192 */
+/* spare 8192 */
#define DEBUG_X_FLAG 0x00004000 /* 16384 */
#define DEBUG_D_FLAG 0x00008000 /* 32768 */
#define DEBUG_S_FLAG 0x00010000 /* 65536 */
#define DEBUG_M_FLAG 0x01000000 /*16777216*/
#define DEBUG_B_FLAG 0x02000000 /*33554432*/
#define DEBUG_L_FLAG 0x04000000 /*67108864*/
-#define DEBUG_MASK 0x07FFEFFF /* mask of all the standard flags */
+#define DEBUG_i_FLAG 0x08000000 /*134217728*/
+#define DEBUG_MASK 0x0FFFEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
-#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
- that something was done? */
-
-# define DEBUG_p_TEST_ (PL_debug & DEBUG_p_FLAG)
-# define DEBUG_s_TEST_ (PL_debug & DEBUG_s_FLAG)
-# define DEBUG_l_TEST_ (PL_debug & DEBUG_l_FLAG)
-# define DEBUG_t_TEST_ (PL_debug & DEBUG_t_FLAG)
-# define DEBUG_o_TEST_ (PL_debug & DEBUG_o_FLAG)
-# define DEBUG_c_TEST_ (PL_debug & DEBUG_c_FLAG)
-# define DEBUG_P_TEST_ (PL_debug & DEBUG_P_FLAG)
-# define DEBUG_m_TEST_ (PL_debug & DEBUG_m_FLAG)
-# define DEBUG_f_TEST_ (PL_debug & DEBUG_f_FLAG)
-# define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG)
-# define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG)
-# define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG)
-# define DEBUG_U_TEST_ (PL_debug & DEBUG_U_FLAG)
-# define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG)
-# define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG)
-# define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG)
-# define DEBUG_S_TEST_ (PL_debug & DEBUG_S_FLAG)
-# define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG)
-# define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
-# define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
-# define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG)
-# define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG)
-# define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG)
-# 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_TOP_FLAG 0x80000000 /* -D was given --> PL_debug |= FLAG */
+
+# define DEBUG_p_TEST_ UNLIKELY(PL_debug & DEBUG_p_FLAG)
+# define DEBUG_s_TEST_ UNLIKELY(PL_debug & DEBUG_s_FLAG)
+# define DEBUG_l_TEST_ UNLIKELY(PL_debug & DEBUG_l_FLAG)
+# define DEBUG_t_TEST_ UNLIKELY(PL_debug & DEBUG_t_FLAG)
+# define DEBUG_o_TEST_ UNLIKELY(PL_debug & DEBUG_o_FLAG)
+# define DEBUG_c_TEST_ UNLIKELY(PL_debug & DEBUG_c_FLAG)
+# define DEBUG_P_TEST_ UNLIKELY(PL_debug & DEBUG_P_FLAG)
+# define DEBUG_m_TEST_ UNLIKELY(PL_debug & DEBUG_m_FLAG)
+# define DEBUG_f_TEST_ UNLIKELY(PL_debug & DEBUG_f_FLAG)
+# define DEBUG_r_TEST_ UNLIKELY(PL_debug & DEBUG_r_FLAG)
+# define DEBUG_x_TEST_ UNLIKELY(PL_debug & DEBUG_x_FLAG)
+# define DEBUG_u_TEST_ UNLIKELY(PL_debug & DEBUG_u_FLAG)
+# define DEBUG_U_TEST_ UNLIKELY(PL_debug & DEBUG_U_FLAG)
+# define DEBUG_X_TEST_ UNLIKELY(PL_debug & DEBUG_X_FLAG)
+# define DEBUG_D_TEST_ UNLIKELY(PL_debug & DEBUG_D_FLAG)
+# define DEBUG_S_TEST_ UNLIKELY(PL_debug & DEBUG_S_FLAG)
+# define DEBUG_T_TEST_ UNLIKELY(PL_debug & DEBUG_T_FLAG)
+# define DEBUG_R_TEST_ UNLIKELY(PL_debug & DEBUG_R_FLAG)
+# define DEBUG_J_TEST_ UNLIKELY(PL_debug & DEBUG_J_FLAG)
+# define DEBUG_v_TEST_ UNLIKELY(PL_debug & DEBUG_v_FLAG)
+# define DEBUG_C_TEST_ UNLIKELY(PL_debug & DEBUG_C_FLAG)
+# define DEBUG_A_TEST_ UNLIKELY(PL_debug & DEBUG_A_FLAG)
+# define DEBUG_q_TEST_ UNLIKELY(PL_debug & DEBUG_q_FLAG)
+# define DEBUG_M_TEST_ UNLIKELY(PL_debug & DEBUG_M_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_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_)
#ifdef DEBUGGING
# define DEBUG_x_TEST DEBUG_x_TEST_
# define DEBUG_u_TEST DEBUG_u_TEST_
# define DEBUG_U_TEST DEBUG_U_TEST_
-# define DEBUG_H_TEST DEBUG_H_TEST_
# define DEBUG_X_TEST DEBUG_X_TEST_
# define DEBUG_D_TEST DEBUG_D_TEST_
# define DEBUG_S_TEST DEBUG_S_TEST_
# define DEBUG_M_TEST DEBUG_M_TEST_
# define DEBUG_B_TEST DEBUG_B_TEST_
# define DEBUG_L_TEST DEBUG_L_TEST_
+# define DEBUG_i_TEST DEBUG_i_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 PERL_DEB(a) a
# define PERL_DEB2(a,b) a
/* Temporarily turn off memory debugging in case the a
* does memory allocation, either directly or indirectly. */
# define DEBUG_m(a) \
- STMT_START { \
- if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \
+ STMT_START { \
+ if (PERL_GET_INTERP) { \
+ dTHX; \
+ if (DEBUG_m_TEST) { \
+ PL_debug &= ~DEBUG_m_FLAG; \
+ a; \
+ PL_debug |= DEBUG_m_FLAG; \
+ } \
+ } \
} STMT_END
-# define DEBUG__(t, a) \
- STMT_START { \
- if (t) STMT_START {a;} STMT_END; \
- } STMT_END
+# define DEBUG__(t, a) \
+ STMT_START { \
+ if (t) STMT_START {a;} STMT_END; \
+ } STMT_END
# 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 */
+
# define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
# define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
# define DEBUG_U(a) DEBUG__(DEBUG_U_TEST, a)
-# define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
# define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a)
# define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a)
# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_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_S(a) DEBUG__(DEBUG_S_TEST, a)
# define DEBUG_T(a) DEBUG__(DEBUG_T_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)
+# define DEBUG_i(a) DEBUG__(DEBUG_i_TEST, a)
#else /* DEBUGGING */
# define DEBUG_x_TEST (0)
# define DEBUG_u_TEST (0)
# define DEBUG_U_TEST (0)
-# define DEBUG_H_TEST (0)
# define DEBUG_X_TEST (0)
# define DEBUG_D_TEST (0)
# define DEBUG_S_TEST (0)
# define DEBUG_M_TEST (0)
# define DEBUG_B_TEST (0)
# define DEBUG_L_TEST (0)
+# define DEBUG_i_TEST (0)
# define DEBUG_Xv_TEST (0)
# define DEBUG_Uv_TEST (0)
# define DEBUG_Pv_TEST (0)
+# define DEBUG_Lv_TEST (0)
# define PERL_DEB(a)
# define PERL_DEB2(a,b) b
# define DEBUG_x(a)
# define DEBUG_u(a)
# define DEBUG_U(a)
-# define DEBUG_H(a)
# define DEBUG_X(a)
# define DEBUG_D(a)
# define DEBUG_S(a)
# define DEBUG_M(a)
# define DEBUG_B(a)
# define DEBUG_L(a)
+# define DEBUG_i(a)
# define DEBUG_Xv(a)
# define DEBUG_Uv(a)
# define DEBUG_Pv(a)
+# define DEBUG_Lv(a)
#endif /* DEBUGGING */
"\", line %d", STRINGIFY(what), __LINE__), \
(void) 0)), ((void)0))
-/* assert() gets defined if DEBUGGING (and I_ASSERT).
+/* assert() gets defined if DEBUGGING.
* If no DEBUGGING, the <assert.h> has not been included. */
#ifndef assert
# define assert(what) Perl_assert(what)
#define PERL_MG_UFUNC(name,ix,sv) I32 name(pTHX_ IV ix, SV *sv)
#endif
-/* Fix these up for __STDC__ */
-#ifndef DONT_DECLARE_STD
-char *mktemp (char*);
-#ifndef atof
-double atof (const char*);
-#endif
-#endif
-
-#ifndef STANDARD_C
-/* All of these are in stdlib.h or time.h for ANSI C */
-Time_t time();
-struct tm *gmtime(), *localtime();
-#if defined(OEMVS)
-char *(strchr)(), *(strrchr)();
-char *(strcpy)(), *(strcat)();
-#else
-char *strchr(), *strrchr();
-char *strcpy(), *strcat();
-#endif
-#endif /* ! STANDARD_C */
-
-
-#ifdef I_MATH
-# include <math.h>
-# ifdef __VMS
+#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);
- double log (double);
- double log10 (double);
- double sqrt (double);
- double frexp (double,int*);
- double ldexp (double,int);
- double modf (double,double*);
- double sin (double);
- double cos (double);
- double atan2 (double,double);
- double pow (double,double);
-END_EXTERN_C
-#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
-#endif
-#if !defined(NV_INF) && defined(INFINITY)
-# define NV_INF (NV)INFINITY
-#endif
-#if !defined(NV_INF) && defined(INF)
-# define NV_INF (NV)INF
-#endif
-#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)
-# define NV_INF ((NV)1.0/0.0) /* Some compilers will warn. */
+# include <fp.h>
#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
-# define NV_QNAN LDBL_QNAN
-# endif
-# if !defined(NV_NAN) && defined(LDBL_SNAN)
-# define NV_SNAN LDBL_SNAN
-# endif
-#endif
-#if !defined(NV_NAN) && defined(DBL_NAN)
-# define NV_NAN (NV)DBL_NAN
-#endif
-#if !defined(NV_NAN) && defined(DBL_QNAN)
-# define NV_NAN (NV)DBL_QNAN
-# define NV_QNAN DBL_QNAN
-#endif
-#if !defined(NV_NAN) && defined(DBL_SNAN)
-# define NV_SNAN DBL_SNAN
-#endif
-#if !defined(NV_NAN) && defined(NAN)
-# define NV_NAN (NV)NAN
-#endif
-#if !defined(NV_NAN) && defined(QNAN)
-# define NV_NAN (NV)QNAN
-# define NV_QNAN QNAN
-#endif
-#if !defined(NV_NAN) && defined(SNAN)
-# define NV_SNAN SNAN
-#endif
-#if !defined(NV_NAN) && defined(I_SUNMATH)
-# define NV_NAN (NV)quiet_nan()
-# define NV_QNAN (NV)quiet_nan()
-# define NV_SNAN (NV)signaling_nan()
-#endif
-#if !defined(NV_NAN)
-# if INTSIZE == 4
-/* 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(WIN32) && !defined(VMS)
#ifndef crypt
char *crypt (const char*, const char*);
#endif
# endif /* !WIN32 */
-# ifndef DONT_DECLARE_STD
-# ifndef getenv
-char *getenv (const char*);
-# endif /* !getenv */
-# if !defined(HAS_LSEEK_PROTO) && !defined(__hpux)
-# ifdef _FILE_OFFSET_BITS
-# if _FILE_OFFSET_BITS == 64
-Off_t lseek (int,Off_t,int);
-# endif
-# endif
-# endif
-# endif /* !DONT_DECLARE_STD */
# ifndef WIN32
# ifndef getlogin
char *getlogin (void);
#if defined(__DYNAMIC__) && defined(PERL_DARWIN) && defined(PERL_CORE)
# include <crt_externs.h> /* for the env array */
# define environ (*_NSGetEnviron())
-#else
+#elif defined(USE_ENVIRON_ARRAY) && !defined(environ)
/* 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(__sgi)
-extern char ** environ; /* environment variables supplied via exec */
-# endif
-# endif
+EXTERN_C char **environ; /* environment variables supplied via exec */
#endif
#define PERL_PATCHLEVEL_H_IMPLICIT
INIT("1");
EXTCONST char PL_No[]
INIT("");
+EXTCONST char PL_Zero[]
+ INIT("0");
EXTCONST char PL_hexdigit[]
INIT("0123456789abcdef0123456789ABCDEF");
EXTCONST char PL_uuemap[65]
INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
+/* a special string address whose value is "isa", but which perl knows
+ * to treat as if it were really "DOES" when printing the method name in
+ * the "Can't call method '%s'" error message */
+EXTCONST char PL_isa_DOES[]
+ INIT("isa");
+
#ifdef DOINIT
EXTCONST char PL_uudmap[256] =
# ifdef PERL_MICRO
192, 193, 194, 195, 196, 197, 198, 199,
200, 201, 202, 203, 204, 205, 206, 207,
208, 209, 210, 211, 212, 213, 214, 215,
- 216, 217, 218, 219, 220, 221, 222, 255 /*sharp s*/,
+ 216, 217, 218, 219, 220, 221, 222,
+#if UNICODE_MAJOR_VERSION > 2 \
+ || (UNICODE_MAJOR_VERSION == 2 && UNICODE_DOT_VERSION >= 1 \
+ && UNICODE_DOT_DOT_VERSION >= 8)
+ 255 /*sharp s*/,
+#else /* uc() is itself in early unicode */
+ 223,
+#endif
224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32,
232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32,
240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247,
"WHEN",
"BLOCK",
"GIVEN",
- "LOOP_FOR",
- "LOOP_PLAIN",
+ "LOOP_ARY",
"LOOP_LAZYSV",
"LOOP_LAZYIV",
+ "LOOP_LIST",
+ "LOOP_PLAIN",
"SUB",
"FORMAT",
"EVAL",
/* These are all the compile time options that affect binary compatibility.
Other compile time options that are binary compatible are in perl.c
- Both are combined for the output of perl -V
+ (in S_Internals_V()). Both are combined for the output of perl -V
However, this string will be embedded in any shared perl library, which will
allow us add a comparison check in perlmain.c in the near future. */
#ifdef DOINIT
# ifdef PERL_NEED_TIMESBASE
" PERL_NEED_TIMESBASE"
# endif
-# ifdef PERL_OLD_COPY_ON_WRITE
- " PERL_OLD_COPY_ON_WRITE"
-# endif
# ifdef PERL_POISON
" PERL_POISON"
# endif
#ifndef PERL_SET_PHASE
# define PERL_SET_PHASE(new_phase) \
- PHASE_CHANGE_PROBE(PL_phase_names[new_phase], PL_phase_names[PL_phase]); \
+ PERL_DTRACE_PROBE_PHASE(new_phase); \
PL_phase = new_phase;
#endif
/* Do not use this macro. It only exists for extensions that rely on PL_dirty
* instead of using the newer PL_phase, which provides everything PL_dirty
* provided, and more. */
-# define PL_dirty (PL_phase == PERL_PHASE_DESTRUCT)
+# define PL_dirty cBOOL(PL_phase == PERL_PHASE_DESTRUCT)
# define PL_amagic_generation PL_na
+# define PL_encoding ((SV *)NULL)
#endif /* !PERL_CORE */
#define PL_hints PL_compiling.cop_hints
+#define PL_maxo MAXO
END_EXTERN_C
/* update exp_name[] in toke.c if adding to this enum */
} expectation;
+#define KEY_sigvar 0xFFFF /* fake keyword representing a signature var */
+
/* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer
special and there is no need for HINT_PRIVATE_MASK for COPs
However, bitops store HINT_INTEGER in their op_private.
*/
/* The following are stored in $^H{sort}, not in PL_hints */
-#define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */
-#define HINT_SORT_QUICKSORT 0x00000001
-#define HINT_SORT_MERGESORT 0x00000002
-#define HINT_SORT_STABLE 0x00000100 /* sort styles (currently one) */
+#define HINT_SORT_STABLE 0x00000100 /* sort styles */
+#define HINT_SORT_UNSTABLE 0x00000200
/* flags for PL_sawampersand */
#include "thread.h"
#include "pp.h"
-#ifndef PERL_CALLCONV
-# ifdef __cplusplus
-# define PERL_CALLCONV extern "C"
-# else
-# define PERL_CALLCONV
-# endif
-#endif
-#ifndef PERL_CALLCONV_NO_RET
-# define PERL_CALLCONV_NO_RET PERL_CALLCONV
-#endif
-
-/* PERL_STATIC_NO_RET is supposed to be equivalent to STATIC on builds that
- dont have a noreturn as a declaration specifier
-*/
-#ifndef PERL_STATIC_NO_RET
-# define PERL_STATIC_NO_RET STATIC
-#endif
-/* PERL_STATIC_NO_RET is supposed to be equivalent to PERL_STATIC_INLINE on
- builds that dont have a noreturn as a declaration specifier
-*/
-#ifndef PERL_STATIC_INLINE_NO_RET
-# define PERL_STATIC_INLINE_NO_RET PERL_STATIC_INLINE
-#endif
-
-
#undef PERL_CKDEF
#undef PERL_PPDEF
#define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o);
# include "malloc_ctl.h"
#endif
+/*
+ * This provides a layer of functions and macros to ensure extensions will
+ * get to use the same RTL functions as the core.
+ */
+#if defined(WIN32)
+# include "win32iop.h"
+#endif
+
+
#include "proto.h"
/* this has structure inits, so it cannot be included before here */
START_EXTERN_C
# include "intrpvar.h"
END_EXTERN_C
+# define PL_sv_yes (PL_sv_immortals[0])
+# define PL_sv_undef (PL_sv_immortals[1])
+# define PL_sv_no (PL_sv_immortals[2])
+# define PL_sv_zero (PL_sv_immortals[3])
#endif
#ifdef PERL_CORE
EXTCONST bool
PL_valid_types_NVX[] = { 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
EXTCONST bool
-PL_valid_types_PVX[] = { 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1, 1 };
+PL_valid_types_PVX[] = { 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1 };
EXTCONST bool
PL_valid_types_RV[] = { 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1 };
EXTCONST bool
#endif
+/* In C99 we could use designated (named field) union initializers.
+ * In C89 we need to initialize the member declared first.
+ * In C++ we need extern C initializers.
+ *
+ * With the U8_NV version you will want to have inner braces,
+ * while with the NV_U8 use just the NV. */
+
+#ifdef __cplusplus
+#define INFNAN_U8_NV_DECL EXTERN_C const union { U8 u8[NVSIZE]; NV nv; }
+#define INFNAN_NV_U8_DECL EXTERN_C const union { NV nv; U8 u8[NVSIZE]; }
+#else
+#define INFNAN_U8_NV_DECL EXTCONST union { U8 u8[NVSIZE]; NV nv; }
+#define INFNAN_NV_U8_DECL EXTCONST union { NV nv; U8 u8[NVSIZE]; }
+#endif
/* if these never got defined, they need defaults */
#ifndef PERL_SET_CONTEXT
#define PERLDB_SAVESRC_NOSUBS (PL_perldb & PERLDBf_SAVESRC_NOSUBS)
#define PERLDB_SAVESRC_INVALID (PL_perldb & PERLDBf_SAVESRC_INVALID)
+#define PERLDB_LINE_OR_SAVESRC (PL_perldb & (PERLDBf_LINE | PERLDBf_SAVESRC))
+
+#ifdef USE_ITHREADS
+# define KEYWORD_PLUGIN_MUTEX_INIT MUTEX_INIT(&PL_keyword_plugin_mutex)
+# 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)
+#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
+#endif
+
#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)
+
+ /* The code is written for simplicity 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
+
+/* We create a C locale object unconditionally if we have the functions to do
+ * so; hence must destroy it unconditionally at the end */
+# ifndef HAS_POSIX_2008_LOCALE
+# define _LOCALE_TERM_POSIX_2008 NOOP
+# else
+# define _LOCALE_TERM_POSIX_2008 \
+ STMT_START { \
+ if (PL_C_locale_obj) { \
+ /* Make sure we aren't using the locale \
+ * space we are about to free */ \
+ uselocale(LC_GLOBAL_LOCALE); \
+ freelocale(PL_C_locale_obj); \
+ PL_C_locale_obj = (locale_t) NULL; \
+ } \
+ } STMT_END
+# endif
+
+# ifndef USE_ITHREADS
+# define LOCALE_INIT
+# define LOCALE_LOCK
+# define LOCALE_UNLOCK
+# define LOCALE_TERM STMT_START { _LOCALE_TERM_POSIX_2008; } STMT_END
+# else /* Below is do use threads */
+# define LOCALE_INIT MUTEX_INIT(&PL_locale_mutex)
+# define LOCALE_LOCK MUTEX_LOCK(&PL_locale_mutex)
+# define LOCALE_UNLOCK MUTEX_UNLOCK(&PL_locale_mutex)
+# define LOCALE_TERM \
+ STMT_START { \
+ MUTEX_DESTROY(&PL_locale_mutex); \
+ _LOCALE_TERM_POSIX_2008; \
+ } STMT_END
+# ifdef HAS_POSIX_2008_LOCALE
+# define USE_POSIX_2008_LOCALE
+# define USE_THREAD_SAFE_LOCALE
+# endif
+# endif
+
/* Returns TRUE if the plain locale pragma without a parameter is in effect
*/
-# define IN_LOCALE_RUNTIME cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE)
+# define IN_LOCALE_RUNTIME (PL_curcop \
+ && CopHINTS_get(PL_curcop) & HINT_LOCALE)
/* Returns TRUE if either form of the locale pragma is in effect */
# define IN_SOME_LOCALE_FORM_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)
+ (PL_curcop && 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))))
+ && Perl__is_in_locale_category(aTHX_ TRUE, (category))))
# define IN_LC_RUNTIME(category) \
(IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \
- && _is_in_locale_category(FALSE, (category))))
+ && Perl__is_in_locale_category(aTHX_ FALSE, (category))))
# define IN_LC(category) \
(IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category))
* 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
+# ifdef USE_LOCALE_CTYPE
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE \
+ STMT_START { \
+ if (UNLIKELY(PL_warn_locale)) { \
+ Perl__warn_problematic_locale(); \
+ } \
+ } STMT_END
+# else
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE
+# endif
/* These two internal macros are called when a warning should be raised,
* 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));
+ STMT_START { \
+ if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
+ Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
+ "Wide character (U+%" UVXf ") in %s",\
+ (UV) cp, OP_DESC(PL_op)); \
+ } \
+ } STMT_END
# 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)) { \
+ if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
UV cp = utf8_to_uvchr_buf((U8 *) s, (U8 *) send, NULL); \
Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
- "Wide character (U+%"UVXf") in %s", \
+ "Wide character (U+%" UVXf ") in %s", \
(cp == 0) \
? UNICODE_REPLACEMENT \
: (UV) cp, \
} STMT_END
# endif /* PERL_CORE or PERL_IN_XSUB_RE */
-
#else /* No locale usage */
+# define LOCALE_INIT
+# define LOCALE_TERM
+# define LOCALE_LOCK
+# define LOCALE_UNLOCK
# define IN_LOCALE_RUNTIME 0
# define IN_SOME_LOCALE_FORM_RUNTIME 0
# define IN_LOCALE_COMPILETIME 0
#ifdef USE_LOCALE_NUMERIC
-/* These macros are for toggling between the underlying locale (LOCAL) and the
- * C locale. */
+/* These macros are for toggling between the underlying locale (UNDERLYING or
+ * LOCAL) and the C locale (STANDARD).
+
+=head1 Locale-related functions and macros
+
+=for apidoc Amn|void|DECLARATION_FOR_LC_NUMERIC_MANIPULATION
+
+This macro should be used as a statement. It declares a private variable
+(whose name begins with an underscore) that is needed by the other macros in
+this section. Failing to include this correctly should lead to a syntax error.
+For compatibility with C89 C compilers it should be placed in a block before
+any executable statements.
+
+=for apidoc Am|void|STORE_LC_NUMERIC_FORCE_TO_UNDERLYING
+
+This is used by XS code that that is C<LC_NUMERIC> locale-aware to force the
+locale for category C<LC_NUMERIC> to be what perl thinks is the current
+underlying locale. (The perl interpreter could be wrong about what the
+underlying locale actually is if some C or XS code has called the C library
+function L<setlocale(3)> behind its back; calling L</sync_locale> before calling
+this macro will update perl's records.)
+
+A call to L</DECLARATION_FOR_LC_NUMERIC_MANIPULATION> must have been made to
+declare at compile time a private variable used by this macro. This macro
+should be called as a single statement, not an expression, but with an empty
+argument list, like this:
+
+ {
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ ...
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
+ ...
+ RESTORE_LC_NUMERIC();
+ ...
+ }
+
+The private variable is used to save the current locale state, so
+that the requisite matching call to L</RESTORE_LC_NUMERIC> can restore it.
+
+=for apidoc Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED
+
+This is used to help wrap XS or C code that that is C<LC_NUMERIC> locale-aware.
+This locale category is generally kept set to the C locale by Perl for
+backwards compatibility, and because most XS code that reads floating point
+values can cope only with the decimal radix character being a dot.
+
+This macro makes sure the current C<LC_NUMERIC> state is set properly, to be
+aware of locale if the call to the XS or C code from the Perl program is
+from within the scope of a S<C<use locale>>; or to ignore locale if the call is
+instead from outside such scope.
+
+This macro is the start of wrapping the C or XS code; the wrap ending is done
+by calling the L</RESTORE_LC_NUMERIC> macro after the operation. Otherwise
+the state can be changed that will adversely affect other XS code.
+
+A call to L</DECLARATION_FOR_LC_NUMERIC_MANIPULATION> must have been made to
+declare at compile time a private variable used by this macro. This macro
+should be called as a single statement, not an expression, but with an empty
+argument list, like this:
+
+ {
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ ...
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+ ...
+ RESTORE_LC_NUMERIC();
+ ...
+ }
+
+=for apidoc Am|void|RESTORE_LC_NUMERIC
+
+This is used in conjunction with one of the macros
+L</STORE_LC_NUMERIC_SET_TO_NEEDED>
+and
+L</STORE_LC_NUMERIC_FORCE_TO_UNDERLYING>
+
+to properly restore the C<LC_NUMERIC> state.
+
+A call to L</DECLARATION_FOR_LC_NUMERIC_MANIPULATION> must have been made to
+declare at compile time a private variable used by this macro and the two
+C<STORE> ones. This macro should be called as a single statement, not an
+expression, but with an empty argument list, like this:
+
+ {
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ ...
+ RESTORE_LC_NUMERIC();
+ ...
+ }
+
+=cut
-/* 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)
+# 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; \
- } \
+ * contrary be noops, in the dynamic scope by setting PL_numeric_standard to 2.
+ * */
+# define _NOT_IN_NUMERIC_UNDERLYING \
+ (! PL_numeric_underlying && PL_numeric_standard < 2)
+
+# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \
+ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL
+
+# define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ if (IN_LC(LC_NUMERIC)) { \
+ if (_NOT_IN_NUMERIC_UNDERLYING) { \
+ Perl_set_numeric_underlying(aTHX); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
+ } \
+ } \
+ else { \
+ if (_NOT_IN_NUMERIC_STANDARD) { \
+ SET_NUMERIC_STANDARD(); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_underlying; \
+ } \
}
-#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); \
+# 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_STANDARD() \
+ STMT_START { if (_NOT_IN_NUMERIC_STANDARD) \
+ Perl_set_numeric_standard(aTHX); \
+ } STMT_END
-#define SET_NUMERIC_LOCAL() \
- STMT_START { if (_NOT_IN_NUMERIC_LOCAL) \
- set_numeric_local(); } STMT_END
+# define SET_NUMERIC_UNDERLYING() \
+ STMT_START { if (_NOT_IN_NUMERIC_UNDERLYING) \
+ Perl_set_numeric_underlying(aTHX); } 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();
+# define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() \
+ bool _was_underlying = _NOT_IN_NUMERIC_STANDARD; \
+ if (_was_underlying) Perl_set_numeric_standard(aTHX);
/* 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();
+# define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() \
+ bool _was_standard = _NOT_IN_NUMERIC_UNDERLYING \
+ && IN_LC(LC_NUMERIC); \
+ if (_was_standard) Perl_set_numeric_underlying(aTHX);
/* Rarely, we want to change to the underlying locale even outside of 'use
* locale'. This is principally in the POSIX:: functions */
-#define STORE_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 STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() \
+ if (_NOT_IN_NUMERIC_UNDERLYING) { \
+ Perl_set_numeric_underlying(aTHX); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
+ }
-#define RESTORE_NUMERIC_LOCAL() \
- if (_was_local) set_numeric_local();
+/* Lock/unlock to the C locale until unlock is called. This needs to be
+ * recursively callable. [perl #128207] */
+# define LOCK_LC_NUMERIC_STANDARD() \
+ (__ASSERT_(PL_numeric_standard) \
+ PL_numeric_standard++)
+# define UNLOCK_LC_NUMERIC_STANDARD() \
+ STMT_START { \
+ if (PL_numeric_standard > 1) { \
+ PL_numeric_standard--; \
+ } \
+ else { \
+ assert(0); \
+ } \
+ } STMT_END
-#define RESTORE_NUMERIC_STANDARD() \
- if (_was_standard) SET_NUMERIC_STANDARD();
+# define RESTORE_LC_NUMERIC_UNDERLYING() \
+ if (_was_underlying) Perl_set_numeric_underlying(aTHX);
-#define Atof my_atof
+# define RESTORE_LC_NUMERIC_STANDARD() \
+ if (_restore_LC_NUMERIC_function) { \
+ _restore_LC_NUMERIC_function(aTHX); \
+ }
#else /* !USE_LOCALE_NUMERIC */
-#define SET_NUMERIC_STANDARD() /**/
-#define SET_NUMERIC_LOCAL() /**/
-#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 SET_NUMERIC_STANDARD()
+# define SET_NUMERIC_UNDERLYING()
+# define IS_NUMERIC_RADIX(a, b) (0)
+# define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD()
+# define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING()
+# define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING()
+# define RESTORE_LC_NUMERIC_UNDERLYING()
+# define RESTORE_LC_NUMERIC_STANDARD()
+# define DECLARATION_FOR_LC_NUMERIC_MANIPULATION
+# define STORE_LC_NUMERIC_SET_TO_NEEDED()
+# define RESTORE_LC_NUMERIC()
+# define LOCK_LC_NUMERIC_STANDARD()
+# define UNLOCK_LC_NUMERIC_STANDARD()
+
+#endif /* !USE_LOCALE_NUMERIC */
#define Atof my_atof
-#endif /* !USE_LOCALE_NUMERIC */
+/* Back-compat names */
+#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION
+#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; \
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+#define LOCK_NUMERIC_STANDARD() LOCK_LC_NUMERIC_STANDARD()
+#define RESTORE_NUMERIC_LOCAL() RESTORE_LC_NUMERIC_UNDERLYING()
+#define RESTORE_NUMERIC_STANDARD() RESTORE_LC_NUMERIC_STANDARD()
+#define SET_NUMERIC_LOCAL() SET_NUMERIC_UNDERLYING()
+#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
+ STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD()
+#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
+ STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING()
+#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING()
+#define UNLOCK_NUMERIC_STANDARD() UNLOCK_LC_NUMERIC_STANDARD()
+
+
#ifdef USE_QUADMATH
# define Perl_strtod(s, e) strtoflt128(s, e)
# ifdef __hpux
# define strtoll __strtoll /* secret handshake */
# endif
-# ifdef WIN64
+# if defined(WIN64) && defined(_MSC_VER)
# define strtoll _strtoi64 /* secret handshake */
# endif
# if !defined(Strtol) && defined(HAS_STRTOLL)
# ifdef __hpux
# define strtoull __strtoull /* secret handshake */
# endif
-# ifdef WIN64
+# if defined(WIN64) && defined(_MSC_VER)
# define strtoull _strtoui64 /* secret handshake */
# endif
# if !defined(Strtoul) && defined(HAS_STRTOULL)
#define PERL_SCRIPT_MODE "r"
#endif
-/*
- * Some operating systems are stingy with stack allocation,
- * so perl may have to guard against stack overflow.
- */
-#ifndef PERL_STACK_OVERFLOW_CHECK
+/* not used. Kept as a NOOP for backcompat */
#define PERL_STACK_OVERFLOW_CHECK() NOOP
-#endif
/*
* Some nonpreemptive operating systems find it convenient to
# define semun gccbug_semun
# endif
# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
-# else
-# ifdef USE_SEMCTL_SEMID_DS
+# elif defined(USE_SEMCTL_SEMID_DS)
# ifdef EXTRA_F_IN_SEMUN_BUF
# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buff)
# else
# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
# endif
-# endif
# endif
#endif
# include <fcntl.h>
#endif
+#ifdef __amigaos4__
+# undef FD_CLOEXEC /* a lie in AmigaOS */
+#endif
+
#ifdef I_SYS_FILE
# include <sys/file.h>
#endif
/* See http://www.unicode.org/unicode/reports/tr13/ */
#define NEXT_LINE_CHAR NEXT_LINE_NATIVE
-/* The UTF-8 bytes of the Unicode LS and PS, U+2028 and U+2029 */
-#define UNICODE_LINE_SEPA_0 0xE2
-#define UNICODE_LINE_SEPA_1 0x80
-#define UNICODE_LINE_SEPA_2 0xA8
-#define UNICODE_PARA_SEPA_0 0xE2
-#define UNICODE_PARA_SEPA_1 0x80
-#define UNICODE_PARA_SEPA_2 0xA9
-
#ifndef PIPESOCK_MODE
# define PIPESOCK_MODE
#endif
#define IS_SAFE_PATHNAME(p, len, op_name) IS_SAFE_SYSCALL((p), (len), "pathname", (op_name))
-#if defined(OEMVS)
+#if defined(OEMVS) || defined(__amigaos4__)
#define NO_ENV_ARRAY_IN_MAIN
#endif
#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_VAX_F_FLOAT || \
+ DOUBLEKIND == DOUBLE_IS_VAX_D_FLOAT || \
+ DOUBLEKIND == DOUBLE_IS_VAX_G_FLOAT
+# define DOUBLE_IS_VAX_FLOAT
+#else
+# define DOUBLE_IS_IEEE_FORMAT
+#endif
+
#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_MIX_ENDIAN
#endif
+/* The VAX fp formats are neither consistently little-endian nor
+ * big-endian, and neither are they really IEEE-mixed endian like
+ * the mixed-endian ARM IEEE formats (with swapped bytes).
+ * Ultimately, the VAX format came from the PDP-11.
+ *
+ * The ordering of the parts in VAX floats is quite vexing.
+ * In the below the fraction_n are the mantissa bits.
+ *
+ * The fraction_1 is the most significant (numbering as by DEC/Digital),
+ * while the rightmost bit in each fraction is the least significant:
+ * in other words, big-endian bit order within the fractions.
+ *
+ * The fraction segments themselves would be big-endianly, except that
+ * within 32 bit segments the less significant half comes first, the more
+ * significant after, except that in the format H (used for long doubles)
+ * the first fraction segment is alone, because the exponent is wider.
+ * This means for example that both the most and the least significant
+ * bits can be in the middle of the floats, not at either end.
+ *
+ * References:
+ * http://nssdc.gsfc.nasa.gov/nssdc/formats/VAXFloatingPoint.htm
+ * http://www.quadibloc.com/comp/cp0201.htm
+ * http://h71000.www7.hp.com/doc/82final/6443/6443pro_028.html
+ * (somebody at HP should be fired for the URLs)
+ *
+ * F fraction_2:16 sign:1 exp:8 fraction_1:7
+ * (exponent bias 128, hidden first one-bit)
+ *
+ * D fraction_2:16 sign:1 exp:8 fraction_1:7
+ * fraction_4:16 fraction_3:16
+ * (exponent bias 128, hidden first one-bit)
+ *
+ * G fraction_2:16 sign:1 exp:11 fraction_1:4
+ * fraction_4:16 fraction_3:16
+ * (exponent bias 1024, hidden first one-bit)
+ *
+ * H fraction_1:16 sign:1 exp:15
+ * fraction_3:16 fraction_2:16
+ * fraction_5:16 fraction_4:16
+ * fraction_7:16 fraction_6:16
+ * (exponent bias 16384, hidden first one-bit)
+ * (available only on VAX, and only on Fortran?)
+ *
+ * The formats S, T and X are available on the Alpha (and Itanium,
+ * also known as I64/IA64) and are equivalent with the IEEE-754 formats
+ * binary32, binary64, and binary128 (commonly: float, double, long double).
+ *
+ * S sign:1 exp:8 mantissa:23
+ * (exponent bias 127, hidden first one-bit)
+ *
+ * T sign:1 exp:11 mantissa:52
+ * (exponent bias 1022, hidden first one-bit)
+ *
+ * X sign:1 exp:15 mantissa:112
+ * (exponent bias 16382, hidden first one-bit)
+ *
+ */
+
+#ifdef DOUBLE_IS_VAX_FLOAT
+# define DOUBLE_VAX_ENDIAN
+#endif
+
+#ifdef DOUBLE_IS_IEEE_FORMAT
/* All the basic IEEE formats have the implicit bit,
- * except for the 80-bit extended formats, which will undef this. */
-#define NV_IMPLICIT_BIT
+ * except for the x86 80-bit extended formats, which will undef this.
+ * Also note that the IEEE 754 subnormals (formerly known as denormals)
+ * do not have the implicit bit of one. */
+# define NV_IMPLICIT_BIT
+#endif
-#ifdef LONG_DOUBLEKIND
+#if defined(LONG_DOUBLEKIND) && LONG_DOUBLEKIND != LONG_DOUBLE_IS_DOUBLE
# 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
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE
# 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
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE
# define LONGDOUBLE_BIG_ENDIAN
# endif
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
+# define LONGDOUBLE_MIX_ENDIAN
+# endif
+
# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
# define LONGDOUBLE_X86_80_BIT
# ifdef USE_LONG_DOUBLE
# undef NV_IMPLICIT_BIT
+# define NV_X86_80_BIT
# endif
# endif
-# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN || \
- LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
# define LONGDOUBLE_DOUBLEDOUBLE
# endif
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_VAX_H_FLOAT
+# define LONGDOUBLE_VAX_ENDIAN
+# endif
+
#endif /* LONG_DOUBLEKIND */
-#if NVSIZE == DOUBLESIZE
+#ifdef USE_QUADMATH /* assume quadmath endianness == native double endianness */
+# if defined(DOUBLE_LITTLE_ENDIAN)
+# define NV_LITTLE_ENDIAN
+# elif defined(DOUBLE_BIG_ENDIAN)
+# define NV_BIG_ENDIAN
+# elif defined(DOUBLE_MIX_ENDIAN) /* stretch */
+# define NV_MIX_ENDIAN
+# endif
+#elif NVSIZE == DOUBLESIZE
# ifdef DOUBLE_LITTLE_ENDIAN
# define NV_LITTLE_ENDIAN
# endif
# ifdef DOUBLE_MIX_ENDIAN
# define NV_MIX_ENDIAN
# endif
+# ifdef DOUBLE_VAX_ENDIAN
+# define NV_VAX_ENDIAN
+# endif
#elif NVSIZE == LONG_DOUBLESIZE
# ifdef LONGDOUBLE_LITTLE_ENDIAN
# define NV_LITTLE_ENDIAN
# ifdef LONGDOUBLE_BIG_ENDIAN
# define NV_BIG_ENDIAN
# endif
+# ifdef LONGDOUBLE_MIX_ENDIAN
+# define NV_MIX_ENDIAN
+# endif
+# ifdef LONGDOUBLE_VAX_ENDIAN
+# define NV_VAX_ENDIAN
+# endif
+#endif
+
+/* We have somehow managed not to define the denormal/subnormal
+ * detection.
+ *
+ * This may happen if the compiler doesn't expose the C99 math like
+ * the fpclassify() without some special switches. Perl tries to
+ * stay C89, so for example -std=c99 is not an option.
+ *
+ * The Perl_isinf() and Perl_isnan() should have been defined even if
+ * the C99 isinf() and isnan() are unavailable, and the NV_MIN becomes
+ * from the C89 DBL_MIN or moral equivalent. */
+#if !defined(Perl_fp_class_denorm) && defined(Perl_isinf) && defined(Perl_isnan) && defined(NV_MIN)
+# define Perl_fp_class_denorm(x) ((x) != 0.0 && !Perl_isinf(x) && !Perl_isnan(x) && PERL_ABS(x) < NV_MIN)
+#endif
+
+/* This is not a great fallback: subnormals tests will fail,
+ * but at least Perl will link and 99.999% of tests will work. */
+#if !defined(Perl_fp_class_denorm)
+# define Perl_fp_class_denorm(x) FALSE
+#endif
+
+#ifdef DOUBLE_IS_IEEE_FORMAT
+# define DOUBLE_HAS_INF
+# define DOUBLE_HAS_NAN
+#endif
+
+#ifdef DOUBLE_HAS_NAN
+
+#ifdef DOINIT
+
+/* PL_inf and PL_nan initialization.
+ *
+ * For inf and nan initialization the ultimate fallback is dividing
+ * one or zero by zero: however, some compilers will warn or even fail
+ * on divide-by-zero, but hopefully something earlier will work.
+ *
+ * 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.
+ *
+ * Also, do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF).
+ * Though logically correct, some compilers (like Visual C 2003)
+ * falsely misoptimize that to zero (x-x is always zero, right?)
+ *
+ * Finally, note that not all floating point formats define Inf (or NaN).
+ * For the infinity a large number may be used instead. Operations that
+ * under the IEEE floating point would return Inf or NaN may return
+ * either large numbers (positive or negative), or they may cause
+ * a floating point exception or some other fault.
+ */
+
+/* The quadmath literals are anon structs which -Wc++-compat doesn't like. */
+GCC_DIAG_IGNORE(-Wc++-compat)
+
+# ifdef USE_QUADMATH
+/* Cannot use HUGE_VALQ for PL_inf because not a compile-time
+ * constant. */
+INFNAN_NV_U8_DECL PL_inf = { 1.0Q/0.0Q };
+# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLINFBYTES)
+INFNAN_U8_NV_DECL PL_inf = { { LONGDBLINFBYTES } };
+# elif NVSIZE == DOUBLESIZE && defined(DOUBLEINFBYTES)
+INFNAN_U8_NV_DECL PL_inf = { { DOUBLEINFBYTES } };
+# else
+# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
+# if defined(LDBL_INFINITY)
+INFNAN_NV_U8_DECL PL_inf = { LDBL_INFINITY };
+# elif defined(LDBL_INF)
+INFNAN_NV_U8_DECL PL_inf = { LDBL_INF };
+# elif defined(INFINITY)
+INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
+# elif defined(INF)
+INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
+# else
+INFNAN_NV_U8_DECL PL_inf = { 1.0L/0.0L }; /* keep last */
+# endif
+# else
+# if defined(DBL_INFINITY)
+INFNAN_NV_U8_DECL PL_inf = { DBL_INFINITY };
+# elif defined(DBL_INF)
+INFNAN_NV_U8_DECL PL_inf = { DBL_INF };
+# elif defined(INFINITY) /* C99 */
+INFNAN_NV_U8_DECL PL_inf = { (NV)INFINITY };
+# elif defined(INF)
+INFNAN_NV_U8_DECL PL_inf = { (NV)INF };
+# else
+INFNAN_NV_U8_DECL PL_inf = { 1.0/0.0 }; /* keep last */
+# endif
+# endif
+# endif
+
+# ifdef USE_QUADMATH
+/* Cannot use nanq("0") for PL_nan because not a compile-time
+ * constant. */
+INFNAN_NV_U8_DECL PL_nan = { 0.0Q/0.0Q };
+# elif NVSIZE == LONG_DOUBLESIZE && defined(LONGDBLNANBYTES)
+INFNAN_U8_NV_DECL PL_nan = { { LONGDBLNANBYTES } };
+# elif NVSIZE == DOUBLESIZE && defined(DOUBLENANBYTES)
+INFNAN_U8_NV_DECL PL_nan = { { DOUBLENANBYTES } };
+# else
+# if NVSIZE == LONG_DOUBLESIZE && defined(USE_LONG_DOUBLE)
+# if defined(LDBL_NAN)
+INFNAN_NV_U8_DECL PL_nan = { LDBL_NAN };
+# elif defined(LDBL_QNAN)
+INFNAN_NV_U8_DECL PL_nan = { LDBL_QNAN };
+# elif defined(NAN)
+INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
+# else
+INFNAN_NV_U8_DECL PL_nan = { 0.0L/0.0L }; /* keep last */
+# endif
+# else
+# if defined(DBL_NAN)
+INFNAN_NV_U8_DECL PL_nan = { DBL_NAN };
+# elif defined(DBL_QNAN)
+INFNAN_NV_U8_DECL PL_nan = { DBL_QNAN };
+# elif defined(NAN) /* C99 */
+INFNAN_NV_U8_DECL PL_nan = { (NV)NAN };
+# else
+INFNAN_NV_U8_DECL PL_nan = { 0.0/0.0 }; /* keep last */
+# endif
+# endif
+# endif
+
+GCC_DIAG_RESTORE
+
+#else
+
+INFNAN_NV_U8_DECL PL_inf;
+INFNAN_NV_U8_DECL PL_nan;
+
+#endif
+
+/* If you have not defined NV_INF/NV_NAN (like for example win32/win32.h),
+ * we will define NV_INF/NV_NAN as the nv part of the global const
+ * PL_inf/PL_nan. Note, however, that the preexisting NV_INF/NV_NAN
+ * might not be a compile-time constant, in which case it cannot be
+ * used to initialize PL_inf/PL_nan above. */
+#ifndef NV_INF
+# define NV_INF PL_inf.nv
+#endif
+#ifndef NV_NAN
+# define NV_NAN PL_nan.nv
#endif
-/* The implicit bit platforms include the implicit bit
- * in the NV_MANT_DIG. The bit isn't really there, however,
- * so the real count of mantissa bits is one less. */
-#ifdef NV_IMPLICIT_BIT
-# define NV_MANT_REAL_DIG (NV_MANT_DIG - 1)
+/* NaNs (not-a-numbers) can carry payload bits, in addition to
+ * "nan-ness". Part of the payload is the quiet/signaling bit.
+ * To back up a bit (harhar):
+ *
+ * For IEEE 754 64-bit formats [1]:
+ *
+ * s 000 (mantissa all-zero) zero
+ * s 000 (mantissa non-zero) subnormals (denormals)
+ * s 001 ... 7fe normals
+ * s 7ff q nan
+ *
+ * For IEEE 754 128-bit formats:
+ *
+ * s 0000 (mantissa all-zero) zero
+ * s 0000 (mantissa non-zero) subnormals (denormals)
+ * s 0001 ... 7ffe normals
+ * s 7fff q nan
+ *
+ * [1] this looks like big-endian, but applies equally to little-endian.
+ *
+ * s = Sign bit. Yes, zeros and nans can have negative sign,
+ * the interpretation is application-specific.
+ *
+ * q = Quietness bit, the interpretation is platform-specific.
+ * Most platforms have the most significant bit being one
+ * meaning quiet, but some (older mips, hppa) have the msb
+ * being one meaning signaling. Note that the above means
+ * that on most platforms there cannot be signaling nan with
+ * zero payload because that is identical with infinity;
+ * while conversely on older mips/hppa there cannot be a quiet nan
+ * because that is identical with infinity.
+ *
+ * Moreover, whether there is any behavioral difference
+ * between quiet and signaling NaNs, depends on the platform.
+ *
+ * x86 80-bit extended precision is different, the mantissa bits:
+ *
+ * 63 62 61 30387+ pre-387 visual c
+ * -------- ---- -------- --------
+ * 0 0 0 invalid infinity
+ * 0 0 1 invalid snan
+ * 0 1 0 invalid snan
+ * 0 1 1 invalid snan
+ * 1 0 0 infinity snan 1.#INF
+ * 1 0 1 snan 1.#SNAN
+ * 1 1 0 qnan -1.#IND (x86 chooses this to negative)
+ * 1 1 1 qnan 1.#QNAN
+ *
+ * This means that in this format there are 61 bits available
+ * for the nan payload.
+ *
+ * Note that the 32-bit x86 ABI cannot do signaling nans: the x87
+ * simply cannot preserve the bit. You can either use the 80-bit
+ * extended precision (long double, -Duselongdouble), or use x86-64.
+ *
+ * In all platforms, the payload bytes (and bits, some of them are
+ * often in a partial byte) themselves can be either all zero (x86),
+ * all one (sparc or mips), or a mixture: in IEEE 754 128-bit double
+ * or in a double-double, the first half of the payload can follow the
+ * native double, while in the second half the payload can be all
+ * zeros. (Therefore the mask for payload bits is not necessarily
+ * identical to bit complement of the NaN.) Another way of putting
+ * this: the payload for the default NaN might not be zero.
+ *
+ * For the x86 80-bit long doubles, the trailing bytes (the 80 bits
+ * being 'packaged' in either 12 or 16 bytes) can be whatever random
+ * garbage.
+ *
+ * Furthermore, the semantics of the sign bit on NaNs are platform-specific.
+ * On normal floats, the sign bit being on means negative. But this may,
+ * or may not, be reverted on NaNs: in other words, the default NaN might
+ * have the sign bit on, and therefore look like negative if you look
+ * at it at the bit level.
+ *
+ * NaN payloads are not propagated even on copies, or in arithmetics.
+ * They *might* be, according to some rules, on your particular
+ * cpu/os/compiler/libraries, but no guarantees.
+ *
+ * To summarize, on most platforms, and for 64-bit doubles
+ * (using big-endian ordering here):
+ *
+ * [7FF8000000000000..7FFFFFFFFFFFFFFF] quiet
+ * [FFF8000000000000..FFFFFFFFFFFFFFFF] quiet
+ * [7FF0000000000001..7FF7FFFFFFFFFFFF] signaling
+ * [FFF0000000000001..FFF7FFFFFFFFFFFF] signaling
+ *
+ * The C99 nan() is supposed to generate *quiet* NaNs.
+ *
+ * Note the asymmetry:
+ * The 7FF0000000000000 is positive infinity,
+ * the FFF0000000000000 is negative infinity.
+ */
+
+/* NVMANTBITS is the number of _real_ mantissa bits in an NV.
+ * For the standard IEEE 754 fp this number is usually one less that
+ * *DBL_MANT_DIG because of the implicit (aka hidden) bit, which isn't
+ * real. For the 80-bit extended precision formats (x86*), the number
+ * of mantissa bits... depends. For normal floats, it's 64. But for
+ * the inf/nan, it's different (zero for inf, 61 for nan).
+ * NVMANTBITS works for normal floats. */
+
+/* We do not want to include the quiet/signaling bit. */
+#define NV_NAN_BITS (NVMANTBITS - 1)
+
+#if defined(USE_LONG_DOUBLE) && NVSIZE > DOUBLESIZE
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 13
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 2
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 7
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 2
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE
+# define NV_NAN_QS_BYTE_OFFSET 13
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE
+# define NV_NAN_QS_BYTE_OFFSET 1
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE
+# define NV_NAN_QS_BYTE_OFFSET 9
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
+# define NV_NAN_QS_BYTE_OFFSET 6
+# else
+# error "Unexpected long double format"
+# endif
#else
-# define NV_MANT_REAL_DIG (NV_MANT_DIG)
+# ifdef USE_QUADMATH
+# ifdef NV_LITTLE_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 13
+# elif defined(NV_BIG_ENDIAN)
+# define NV_NAN_QS_BYTE_OFFSET 2
+# else
+# error "Unexpected quadmath format"
+# endif
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 2
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 1
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 6
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 1
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 13
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+# define NV_NAN_QS_BYTE_OFFSET 2
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE
+# define NV_NAN_QS_BYTE_OFFSET 2 /* bytes 4 5 6 7 0 1 2 3 (MSB 7) */
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE
+# define NV_NAN_QS_BYTE_OFFSET 5 /* bytes 3 2 1 0 7 6 5 4 (MSB 7) */
+# else
+/* For example the VAX formats should never
+ * get here because they do not have NaN. */
+# error "Unexpected double format"
+# endif
+#endif
+/* NV_NAN_QS_BYTE is the byte to test for the quiet/signaling */
+#define NV_NAN_QS_BYTE(nvp) (((U8*)(nvp))[NV_NAN_QS_BYTE_OFFSET])
+/* NV_NAN_QS_BIT is the bit to test in the NV_NAN_QS_BYTE_OFFSET
+ * for the quiet/signaling */
+#if defined(USE_LONG_DOUBLE) && \
+ (LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN)
+# define NV_NAN_QS_BIT_SHIFT 6 /* 0x40 */
+#elif defined(USE_LONG_DOUBLE) && \
+ (LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE)
+# define NV_NAN_QS_BIT_SHIFT 3 /* 0x08, but not via NV_NAN_BITS */
+#else
+# define NV_NAN_QS_BIT_SHIFT ((NV_NAN_BITS) % 8) /* usually 3, or 0x08 */
+#endif
+#define NV_NAN_QS_BIT (1 << (NV_NAN_QS_BIT_SHIFT))
+/* NV_NAN_QS_BIT_OFFSET is the bit offset from the beginning of a NV
+ * (bytes ordered big-endianly) for the quiet/signaling bit
+ * for the quiet/signaling */
+#define NV_NAN_QS_BIT_OFFSET \
+ (8 * (NV_NAN_QS_BYTE_OFFSET) + (NV_NAN_QS_BIT_SHIFT))
+/* NV_NAN_QS_QUIET (always defined) is true if the NV_NAN_QS_QS_BIT being
+ * on indicates quiet NaN. NV_NAN_QS_SIGNALING (also always defined)
+ * is true if the NV_NAN_QS_BIT being on indicates signaling NaN. */
+#define NV_NAN_QS_QUIET \
+ ((NV_NAN_QS_BYTE(PL_nan.u8) & NV_NAN_QS_BIT) == NV_NAN_QS_BIT)
+#define NV_NAN_QS_SIGNALING (!(NV_NAN_QS_QUIET))
+#define NV_NAN_QS_TEST(nvp) (NV_NAN_QS_BYTE(nvp) & NV_NAN_QS_BIT)
+/* NV_NAN_IS_QUIET() returns true if the NV behind nvp is a NaN,
+ * whether it is a quiet NaN, NV_NAN_IS_SIGNALING() if a signaling NaN.
+ * Note however that these do not check whether the nvp is a NaN. */
+#define NV_NAN_IS_QUIET(nvp) \
+ (NV_NAN_QS_TEST(nvp) == (NV_NAN_QS_QUIET ? NV_NAN_QS_BIT : 0))
+#define NV_NAN_IS_SIGNALING(nvp) \
+ (NV_NAN_QS_TEST(nvp) == (NV_NAN_QS_QUIET ? 0 : NV_NAN_QS_BIT))
+#define NV_NAN_SET_QUIET(nvp) \
+ (NV_NAN_QS_QUIET ? \
+ (NV_NAN_QS_BYTE(nvp) |= NV_NAN_QS_BIT) : \
+ (NV_NAN_QS_BYTE(nvp) &= ~NV_NAN_QS_BIT))
+#define NV_NAN_SET_SIGNALING(nvp) \
+ (NV_NAN_QS_QUIET ? \
+ (NV_NAN_QS_BYTE(nvp) &= ~NV_NAN_QS_BIT) : \
+ (NV_NAN_QS_BYTE(nvp) |= NV_NAN_QS_BIT))
+#define NV_NAN_QS_XOR(nvp) (NV_NAN_QS_BYTE(nvp) ^= NV_NAN_QS_BIT)
+
+/* NV_NAN_PAYLOAD_MASK: masking the nan payload bits.
+ *
+ * NV_NAN_PAYLOAD_PERM: permuting the nan payload bytes.
+ * 0xFF means "don't go here".*/
+
+/* Shorthands to avoid typoses. */
+#define NV_NAN_PAYLOAD_MASK_SKIP_EIGHT \
+ 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0
+#define NV_NAN_PAYLOAD_PERM_SKIP_EIGHT \
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff
+#define NV_NAN_PAYLOAD_PERM_0_TO_7 \
+ 0x0, 0x1, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7
+#define NV_NAN_PAYLOAD_PERM_7_TO_0 \
+ 0x7, 0x6, 0x5, 0x4, 0x3, 0x2, 0x1, 0x0
+#define NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE \
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, \
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00, 0x00
+#define NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE \
+ NV_NAN_PAYLOAD_PERM_0_TO_7, \
+ 0x8, 0x9, 0xa, 0xb, 0xc, 0xd, 0xFF, 0xFF
+#define NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE \
+ 0x00, 0x00, 0x7f, 0xff, 0xff, 0xff, 0xff, 0xff, \
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff
+#define NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE \
+ 0xFF, 0xFF, 0xd, 0xc, 0xb, 0xa, 0x9, 0x8, \
+ NV_NAN_PAYLOAD_PERM_7_TO_0
+#define NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE \
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x07, 0x00
+#define NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE \
+ 0x0, 0x1, 0x2, 0x3, 0x4, 0x5, 0x6, 0xFF
+#define NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE \
+ 0x00, 0x07, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff
+#define NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE \
+ 0xFF, 0x6, 0x5, 0x4, 0x3, 0x2, 0x1, 0x0
+
+#if defined(USE_LONG_DOUBLE) && NVSIZE > DOUBLESIZE
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
+# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE
+# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE
+# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
+# if LONG_DOUBLESIZE == 10
+# define NV_NAN_PAYLOAD_MASK \
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \
+ 0x00, 0x00
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_0_TO_7, 0xFF, 0xFF
+# elif LONG_DOUBLESIZE == 12
+# define NV_NAN_PAYLOAD_MASK \
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \
+ 0x00, 0x00, 0x00, 0x00
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_0_TO_7, 0xFF, 0xFF, 0xFF, 0xFF
+# elif LONG_DOUBLESIZE == 16
+# define NV_NAN_PAYLOAD_MASK \
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, \
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_0_TO_7, \
+ 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF
+# else
+# error "Unexpected x86 80-bit little-endian long double format"
+# endif
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
+# if LONG_DOUBLESIZE == 10
+# define NV_NAN_PAYLOAD_MASK \
+ 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \
+ 0xff, 0xff
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_7_TO_0, 0xFF, 0xFF
+# elif LONG_DOUBLESIZE == 12
+# define NV_NAN_PAYLOAD_MASK \
+ 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \
+ 0xff, 0xff, 0x00, 0x00
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_7_TO_0, 0xFF, 0xFF, 0xFF, 0xFF
+# elif LONG_DOUBLESIZE == 16
+# define NV_NAN_PAYLOAD_MASK \
+ 0x00, 0x00, 0x1f, 0xff, 0xff, 0xff, 0xff, 0xff, \
+ 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_7_TO_0, \
+ 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF
+# else
+# error "Unexpected x86 80-bit big-endian long double format"
+# endif
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE
+/* For double-double we assume only the first double (in LE or BE terms)
+ * is used for NaN. */
+# define NV_NAN_PAYLOAD_MASK \
+ NV_NAN_PAYLOAD_MASK_SKIP_EIGHT, NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_SKIP_EIGHT, NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE
+# define NV_NAN_PAYLOAD_MASK \
+ NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE
+# define NV_NAN_PAYLOAD_MASK \
+ NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
+# define NV_NAN_PAYLOAD_MASK \
+ NV_NAN_PAYLOAD_MASK_SKIP_EIGHT, NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE
+# define NV_NAN_PAYLOAD_PERM \
+ NV_NAN_PAYLOAD_PERM_SKIP_EIGHT, NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE
+# else
+# error "Unexpected long double format"
+# endif
+#else
+# ifdef USE_QUADMATH /* quadmath is not long double */
+# ifdef NV_LITTLE_ENDIAN
+# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE
+# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE
+# elif defined(NV_BIG_ENDIAN)
+# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE
+# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE
+# else
+# error "Unexpected quadmath format"
+# endif
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN
+# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0x07, 0x00
+# define NV_NAN_PAYLOAD_PERM 0x0, 0x1, 0x2, 0xFF
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_BIG_ENDIAN
+# define NV_NAN_PAYLOAD_MASK 0x00, 0x07, 0xff, 0xff
+# define NV_NAN_PAYLOAD_PERM 0xFF, 0x2, 0x1, 0x0
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN
+# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_64_LE
+# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_64_LE
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_BIG_ENDIAN
+# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_64_BE
+# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_64_BE
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
+# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_LE
+# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_LE
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+# define NV_NAN_PAYLOAD_MASK NV_NAN_PAYLOAD_MASK_IEEE_754_128_BE
+# define NV_NAN_PAYLOAD_PERM NV_NAN_PAYLOAD_PERM_IEEE_754_128_BE
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE
+# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0x07, 0x00, 0xff, 0xff, 0xff, 0xff
+# define NV_NAN_PAYLOAD_PERM 0x4, 0x5, 0x6, 0xFF, 0x0, 0x1, 0x2, 0x3
+# elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE
+# define NV_NAN_PAYLOAD_MASK 0xff, 0xff, 0xff, 0xff, 0x00, 0x07, 0xff, 0xff
+# define NV_NAN_PAYLOAD_PERM 0x3, 0x2, 0x1, 0x0, 0xFF, 0x6, 0x5, 0x4
+# else
+# error "Unexpected double format"
+# endif
#endif
+#endif /* DOUBLE_HAS_NAN */
+
+
/*
(KEEP THIS LAST IN perl.h!)
#endif /* Include guard */
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff