#ifdef PERL_MICRO
# include "uconfig.h"
#else
-# ifndef USE_CROSS_COMPILE
-# include "config.h"
-# else
-# include "xconfig.h"
-# endif
+# include "config.h"
#endif
/* See L<perlguts/"The Perl API"> for detailed notes on
# define PERL_UNUSED_CONTEXT
#endif
+/* on gcc (and clang), specify that a warning should be temporarily
+ * ignored; e.g.
+ *
+ * GCC_DIAG_IGNORE(-Wmultichar);
+ * char b = 'ab';
+ * GCC_DIAG_RESTORE;
+ *
+ * based on http://dbp-consulting.com/tutorials/SuppressingGCCWarnings.html
+ *
+ * Note that "pragma GCC diagnostic push/pop" was added in GCC 4.6, Mar 2011;
+ * clang only pretends to be GCC 4.2, but still supports push/pop.
+ */
+
+#if defined(__clang) || \
+ (defined( __GNUC__) && ((__GNUC__ * 100) + __GNUC_MINOR__) >= 406)
+# define GCC_DIAG_DO_PRAGMA_(x) _Pragma (#x)
+
+# define GCC_DIAG_IGNORE(x) _Pragma("GCC diagnostic push") \
+ GCC_DIAG_DO_PRAGMA_(GCC diagnostic ignored #x)
+# define GCC_DIAG_RESTORE _Pragma("GCC diagnostic pop")
+#else
+# define GCC_DIAG_IGNORE(w)
+# define GCC_DIAG_RESTORE
+#endif
+
+
#define NOOP /*EMPTY*/(void)0
/* cea2e8a9dd23747f accidentally lost the comment originally from the first
check in of thread.h, explaining why we need dNOOP at all: */
#endif
#ifndef pTHX
-/* Don't bother defining tTHX and sTHX; using them outside
+/* Don't bother defining tTHX ; using it outside
* code guarded by PERL_IMPLICIT_CONTEXT is an error.
*/
# define pTHX void
* DANGER! Using NO_TAINT_SUPPORT or SILENT_NO_TAINT_SUPPORT
* voids your nonexistent warranty!
*/
-#if SILENT_NO_TAINT_SUPPORT && !defined(NO_TAINT_SUPPORT)
+#if defined(SILENT_NO_TAINT_SUPPORT) && !defined(NO_TAINT_SUPPORT)
# define NO_TAINT_SUPPORT 1
#endif
* operations into no-ops for a very modest speed-up. Enable only if you
* know what you're doing: tests and CPAN modules' tests are bound to fail.
*/
-#if NO_TAINT_SUPPORT
+#ifdef NO_TAINT_SUPPORT
# define TAINT NOOP
# define TAINT_NOT NOOP
# define TAINT_IF(c) NOOP
# if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY)
# define USE_LOCALE_MONETARY
# endif
+# ifndef WIN32 /* No wrapper except on Windows */
+# define my_setlocale(a,b) setlocale(a,b)
+# endif
#endif /* !NO_LOCALE && HAS_SETLOCALE */
#include <setjmp.h>
# include <arpa/inet.h>
#endif
-#if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
-/* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
- * (the neo-BSD seem to do this). */
-# undef SF_APPEND
-#endif
-
#ifdef I_SYS_STAT
# include <sys/stat.h>
#endif
# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif
-#define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */
-
#ifndef errno
extern int errno; /* ANSI allows errno to be an lvalue expr.
* For example in multithreaded environments
* #define errno (*_errno()) */
#endif
+#define UNKNOWN_ERRNO_MSG "(unknown)"
+
#ifdef HAS_STRERROR
# ifndef DONT_DECLARE_STD
# ifdef VMS
extern char *sys_errlist[];
# ifndef Strerror
# define Strerror(e) \
- ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
+ ((e) < 0 || (e) >= sys_nerr ? UNKNOWN_ERRNO_MSG : sys_errlist[e])
# endif
# endif
#endif
/*
=for apidoc Am|void|PERL_SYS_INIT|int *argc|char*** argv
Provides system-specific tune up of the C runtime environment necessary to
-run Perl interpreters. This should be called only once, before creating
+run Perl interpreters. This should be called only once, before creating
any Perl interpreters.
=for apidoc Am|void|PERL_SYS_INIT3|int *argc|char*** argv|char*** env
Provides system-specific tune up of the C runtime environment necessary to
-run Perl interpreters. This should be called only once, before creating
+run Perl interpreters. This should be called only once, before creating
any Perl interpreters.
=for apidoc Am|void|PERL_SYS_TERM|
Provides system-specific clean up of the C runtime environment after
-running Perl interpreters. This should be called only once, after
+running Perl interpreters. This should be called only once, after
freeing any remaining Perl interpreters.
=cut
* out there, Solaris being the most prominent.
*/
#ifndef PERL_FLUSHALL_FOR_CHILD
-# if defined(USE_PERLIO) || defined(FFLUSH_NULL) || defined(USE_SFIO)
+# if defined(USE_PERLIO) || defined(FFLUSH_NULL)
# define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL)
# else
# ifdef FFLUSH_ALL
/* Takes three arguments: is_utf8, length, str */
#ifndef UTF8f
-# define UTF8f "d%"UVuf"%4p"
+# define UTF8f "d%" UVuf "%4p"
#endif
#define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p)
appropriate to call return. In either case, include the lint directive.
*/
#ifdef HASATTRIBUTE_NORETURN
-# define NORETURN_FUNCTION_END assert(0); /* NOTREACHED */
+# define NORETURN_FUNCTION_END NOT_REACHED; /* NOTREACHED */
#else
-# define NORETURN_FUNCTION_END assert(0); /* NOTREACHED */ return 0
+# define NORETURN_FUNCTION_END NOT_REACHED; /* NOTREACHED */ return 0
#endif
/* Some OS warn on NULL format to printf */
/* placeholder */
#endif
+
+#ifndef __has_builtin
+# define __has_builtin(x) 0 /* not a clang style compiler */
+#endif
+
+/* ASSUME is like assert(), but it has a benefit in a release build. It is a
+ hint to a compiler about a statement of fact in a function call free
+ expression, which allows the compiler to generate better machine code.
+ In a debug build, ASSUME(x) is a synonym for assert(x). ASSUME(0) means
+ the control path is unreachable. In a for loop, ASSUME can be used to hint
+ that a loop will run atleast X times. ASSUME is based off MSVC's __assume
+ intrinsic function, see its documents for more details.
+*/
+
+#ifndef DEBUGGING
+# if __has_builtin(__builtin_unreachable) \
+ || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 5) /* 4.5 -> */
+# define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable())
+# elif defined(_MSC_VER)
+# define ASSUME(x) __assume(x)
+# elif defined(__ARMCC_VERSION) /* untested */
+# define ASSUME(x) __promise(x)
+# else
+/* a random compiler might define assert to its own special optimization token
+ so pass it through to C lib as a last resort */
+# define ASSUME(x) assert(x)
+# endif
+#else
+# define ASSUME(x) assert(x)
+#endif
+
+#define NOT_REACHED ASSUME(0)
+
/* Some unistd.h's give a prototype for pause() even though
HAS_PAUSE ends up undefined. This causes the #define
below to be rejected by the compiler. Sigh.
union any {
void* any_ptr;
I32 any_i32;
+ U32 any_u32;
IV any_iv;
UV any_uv;
long any_long;
* before their definitions in regcomp.h. */
struct scan_data_t;
+typedef struct regnode_charclass regnode_charclass;
+
struct regnode_charclass_class;
/* A hopefully less confusing name. The sub-classes are all Posix classes only
* used under /l matching */
typedef struct regnode_charclass_class regnode_charclass_posixl;
+typedef struct regnode_charclass_posixl_fold regnode_charclass_posixl_fold;
typedef struct regnode_ssc regnode_ssc;
typedef struct RExC_state_t RExC_state_t;
#define DEBUG_q_FLAG 0x00800000 /*8388608 */
#define DEBUG_M_FLAG 0x01000000 /*16777216*/
#define DEBUG_B_FLAG 0x02000000 /*33554432*/
-#define DEBUG_MASK 0x03FFEFFF /* mask of all the standard flags */
+#define DEBUG_L_FLAG 0x04000000 /*67108864*/
+#define DEBUG_MASK 0x07FFEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
# define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
# define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG)
# define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG)
+# define DEBUG_L_TEST_ (PL_debug & DEBUG_L_FLAG)
# define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_)
# define DEBUG_q_TEST DEBUG_q_TEST_
# define DEBUG_M_TEST DEBUG_M_TEST_
# define DEBUG_B_TEST DEBUG_B_TEST_
+# define DEBUG_L_TEST DEBUG_L_TEST_
# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
# define DEBUG_Uv_TEST DEBUG_Uv_TEST_
# define DEBUG_Pv_TEST DEBUG_Pv_TEST_
# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
# define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a)
# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a)
+# define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a)
#else /* DEBUGGING */
# define DEBUG_q_TEST (0)
# define DEBUG_M_TEST (0)
# define DEBUG_B_TEST (0)
+# define DEBUG_L_TEST (0)
# define DEBUG_Xv_TEST (0)
# define DEBUG_Uv_TEST (0)
# define DEBUG_Pv_TEST (0)
# define DEBUG_q(a)
# define DEBUG_M(a)
# define DEBUG_B(a)
+# define DEBUG_L(a)
# define DEBUG_Xv(a)
# define DEBUG_Uv(a)
# define DEBUG_Pv(a)
# define RUNOPS_DEFAULT Perl_runops_standard
#endif
-#ifdef USE_PERLIO
+#if defined(USE_PERLIO)
EXTERN_C void PerlIO_teardown(void);
# ifdef USE_ITHREADS
# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex)
struct perl_memory_debug_header;
struct perl_memory_debug_header {
tTHX interpreter;
-# ifdef PERL_POISON
+# if defined(PERL_POISON) || defined(PERL_DEBUG_READONLY_COW)
MEM_SIZE size;
# endif
struct perl_memory_debug_header *prev;
struct perl_memory_debug_header *next;
+# ifdef PERL_DEBUG_READONLY_COW
+ bool readonly;
+# endif
};
-# define sTHX (sizeof(struct perl_memory_debug_header) + \
+#elif defined(PERL_DEBUG_READONLY_COW)
+
+struct perl_memory_debug_header;
+struct perl_memory_debug_header {
+ MEM_SIZE size;
+};
+
+#endif
+
+#if defined (PERL_TRACK_MEMPOOL) || defined (PERL_DEBUG_READONLY_COW)
+
+# define PERL_MEMORY_DEBUG_HEADER_SIZE \
+ (sizeof(struct perl_memory_debug_header) + \
(MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
%MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
#else
-# define sTHX 0
+# define PERL_MEMORY_DEBUG_HEADER_SIZE 0
#endif
#ifdef PERL_TRACK_MEMPOOL
+# ifdef PERL_DEBUG_READONLY_COW
# define INIT_TRACK_MEMPOOL(header, interp) \
STMT_START { \
(header).interpreter = (interp); \
(header).prev = (header).next = &(header); \
+ (header).readonly = 0; \
} STMT_END
-# else
+# else
+# define INIT_TRACK_MEMPOOL(header, interp) \
+ STMT_START { \
+ (header).interpreter = (interp); \
+ (header).prev = (header).next = &(header); \
+ } STMT_END
+# endif
+# else
# define INIT_TRACK_MEMPOOL(header, interp)
#endif
#ifdef MYMALLOC
# define Perl_safesysmalloc_size(where) Perl_malloced_size(where)
#else
-# ifdef HAS_MALLOC_SIZE
+# if defined(HAS_MALLOC_SIZE) && !defined(PERL_DEBUG_READONLY_COW)
# ifdef PERL_TRACK_MEMPOOL
# define Perl_safesysmalloc_size(where) \
- (malloc_size(((char *)(where)) - sTHX) - sTHX)
+ (malloc_size(((char *)(where)) - PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE)
# else
# define Perl_safesysmalloc_size(where) malloc_size(where)
# endif
# ifdef HAS_MALLOC_GOOD_SIZE
# ifdef PERL_TRACK_MEMPOOL
# define Perl_malloc_good_size(how_much) \
- (malloc_good_size((how_much) + sTHX) - sTHX)
+ (malloc_good_size((how_much) + PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE)
# else
# define Perl_malloc_good_size(how_much) malloc_good_size(how_much)
# endif
EXTCONST char PL_warn_uninit[]
INIT("Use of uninitialized value%s%s%s");
EXTCONST char PL_warn_uninit_sv[]
- INIT("Use of uninitialized value%"SVf"%s%s");
+ INIT("Use of uninitialized value%" SVf "%s%s");
EXTCONST char PL_warn_nosemi[]
INIT("Semicolon seems to be missing");
EXTCONST char PL_warn_reserved[]
EXTCONST char PL_no_aelem[]
INIT("Modification of non-creatable array value attempted, subscript %d");
EXTCONST char PL_no_helem_sv[]
- INIT("Modification of non-creatable hash value attempted, subscript \"%"SVf"\"");
+ INIT("Modification of non-creatable hash value attempted, subscript \"%" SVf "\"");
EXTCONST char PL_no_modify[]
INIT("Modification of a read-only value attempted");
EXTCONST char PL_no_mem[sizeof("Out of memory!\n")]
# ifdef USE_REENTRANT_API
" USE_REENTRANT_API"
# endif
-# ifdef USE_SFIO
- " USE_SFIO"
-# endif
# ifdef USE_SOCKS
" USE_SOCKS"
# endif
/* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer
special and there is no need for HINT_PRIVATE_MASK for COPs
- However, bitops store HINT_INTEGER in their op_private. */
+ However, bitops store HINT_INTEGER in their op_private.
+
+ NOTE: The typical module using these has the bit value hard-coded, so don't
+ blindly change the values of these */
#define HINT_INTEGER 0x00000001 /* integer pragma */
#define HINT_STRICT_REFS 0x00000002 /* strict pragma */
#define HINT_LOCALE 0x00000004 /* locale pragma */
#ifdef USE_LOCALE_NUMERIC
-#define SET_NUMERIC_STANDARD() \
- set_numeric_standard();
-
-#define SET_NUMERIC_LOCAL() \
- set_numeric_local();
-
-/* Returns non-zero If the plain locale pragma without a parameter is in effect
+/* Returns TRUE if the plain locale pragma without a parameter is in effect
*/
-#define IN_LOCALE_RUNTIME (CopHINTS_get(PL_curcop) & HINT_LOCALE)
+#define IN_LOCALE_RUNTIME cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE)
-/* Returns non-zero If either form of the locale pragma is in effect */
+/* Returns TRUE if either form of the locale pragma is in effect */
#define IN_SOME_LOCALE_FORM_RUNTIME \
- (CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS))
+ cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS))
-#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
+#define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE)
#define IN_SOME_LOCALE_FORM_COMPILETIME \
- (PL_hints & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS))
+ cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS))
#define IN_LOCALE \
(IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
(IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \
: IN_SOME_LOCALE_FORM_RUNTIME)
+/* These macros are for toggling between the underlying locale (LOCAL) and the
+ * C locale. */
+
+/* The first set makes sure that the locale is set to C unless within a 'use
+ * locale's scope; otherwise to the default locale. A function pointer is
+ * used, which can be declared separately by
+ * DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED, followed by the actual
+ * setting (using STORE_LC_NUMERIC_SET_TO_NEEDED()), or the two can be combined
+ * into one call DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED().
+ * RESTORE_LC_NUMERIC() in all cases restores the locale to what it was before
+ * these were called */
+
+#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \
+ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL;
+
+#define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ if (IN_SOME_LOCALE_FORM) { \
+ if (! PL_numeric_local) { \
+ SET_NUMERIC_LOCAL(); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
+ } \
+ } \
+ else { \
+ if (! PL_numeric_standard) { \
+ SET_NUMERIC_STANDARD(); \
+ _restore_LC_NUMERIC_function = &Perl_set_numeric_local; \
+ } \
+ }
+
+#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; \
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+
+#define RESTORE_LC_NUMERIC() \
+ if (_restore_LC_NUMERIC_function) { \
+ _restore_LC_NUMERIC_function(aTHX); \
+ }
+
+/* The next two macros set unconditionally. These should be rarely used, and
+ * only after being sure that this is what is needed */
+#define SET_NUMERIC_STANDARD() \
+ set_numeric_standard();
+
+#define SET_NUMERIC_LOCAL() \
+ set_numeric_local();
+
+/* 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 = PL_numeric_local && IN_LOCALE; \
+ bool was_local = PL_numeric_local; \
if (was_local) SET_NUMERIC_STANDARD();
+/* Doesn't change to underlying locale unless within the scope of some form of
+ * 'use locale'. This is the usual desired behavior. */
#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
- bool was_standard = PL_numeric_standard && IN_LOCALE; \
+ bool was_standard = PL_numeric_standard && IN_SOME_LOCALE_FORM; \
+ if (was_standard) SET_NUMERIC_LOCAL();
+
+/* Rarely, we want to change to the underlying locale even outside of 'use
+ * locale'. This is principally in the POSIX:: functions */
+#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \
+ bool was_standard = PL_numeric_standard; \
if (was_standard) SET_NUMERIC_LOCAL();
#define RESTORE_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 Atof my_atof
#define IN_LOCALE_RUNTIME 0
#define IN_LOCALE_COMPILETIME 0
#define PERL_PV_ESCAPE_NOCLEAR 0x4000
#define PERL_PV_ESCAPE_RE 0x8000
+#define PERL_PV_ESCAPE_DWIM 0x10000
+
#define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
/* used by pv_display in dump.c*/
https://perl5.git.perl.org / perl5.git / blobdiff