/* perl.h
*
- * Copyright (c) 1987-2002, Larry Wall
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* 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(__APPLE__)
+#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN)
# define USE_REENTRANT_API
#endif
/* <--- here ends the logic shared by perl.h and makedef.pl */
+/*
+ * PERL_DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned)
+ * (The -DPERL_DARWIN comes from the hints/darwin.sh.)
+ * __bsdi__ for BSD/OS
+ */
+#if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(PERL_DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44)
+# ifndef BSDish
+# define BSDish
+# endif
+#endif
+
#ifdef PERL_IMPLICIT_CONTEXT
# ifndef MULTIPLICITY
# define MULTIPLICITY
#endif
#ifdef HASATTRIBUTE
-# if defined(__GNUC__) && defined(__cplusplus)
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
# define PERL_UNUSED_DECL
# else
# define PERL_UNUSED_DECL __attribute__((unused))
# endif
#endif
+#if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+#endif
+
/*
* STMT_START { statements; } STMT_END;
* can be used as a single statement, as in
* Trying to select a version that gives no warnings...
*/
#if !(defined(STMT_START) && defined(STMT_END))
-# if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) && !defined(__cplusplus)
+# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
# define STMT_END )
# else
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
# define DONT_DECLARE_STD 1
#endif
# define MYSWAP
#endif
+#ifdef PERL_CORE
+
+/* macros for correct constant construction */
+# if INTSIZE >= 2
+# define U16_CONST(x) ((U16)x##U)
+# else
+# define U16_CONST(x) ((U16)x##UL)
+# endif
+
+# if INTSIZE >= 4
+# define U32_CONST(x) ((U32)x##U)
+# else
+# define U32_CONST(x) ((U32)x##UL)
+# endif
+
+# ifdef HAS_QUAD
+# if INTSIZE >= 8
+# define U64_CONST(x) ((U64)x##U)
+# elif LONGSIZE >= 8
+# define U64_CONST(x) ((U64)x##UL)
+# elif QUADKIND == QUAD_IS_LONG_LONG
+# define U64_CONST(x) ((U64)x##ULL)
+# else /* best guess we can make */
+# define U64_CONST(x) ((U64)x##UL)
+# endif
+# endif
+
+/* byte-swapping functions for big-/little-endian conversion */
+# define _swab_16_(x) ((U16)( \
+ (((U16)(x) & U16_CONST(0x00ff)) << 8) | \
+ (((U16)(x) & U16_CONST(0xff00)) >> 8) ))
+
+# define _swab_32_(x) ((U32)( \
+ (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \
+ (((U32)(x) & U32_CONST(0x0000ff00)) << 8) | \
+ (((U32)(x) & U32_CONST(0x00ff0000)) >> 8) | \
+ (((U32)(x) & U32_CONST(0xff000000)) >> 24) ))
+
+# ifdef HAS_QUAD
+# define _swab_64_(x) ((U64)( \
+ (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \
+ (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \
+ (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \
+ (((U64)(x) & U64_CONST(0x00000000ff000000)) << 8) | \
+ (((U64)(x) & U64_CONST(0x000000ff00000000)) >> 8) | \
+ (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \
+ (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \
+ (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) ))
+# endif
+
+/*----------------------------------------------------------------------------*/
+# if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 /* little-endian */
+/*----------------------------------------------------------------------------*/
+# define my_htole16(x) (x)
+# define my_letoh16(x) (x)
+# define my_htole32(x) (x)
+# define my_letoh32(x) (x)
+# define my_htobe16(x) _swab_16_(x)
+# define my_betoh16(x) _swab_16_(x)
+# define my_htobe32(x) _swab_32_(x)
+# define my_betoh32(x) _swab_32_(x)
+# ifdef HAS_QUAD
+# define my_htole64(x) (x)
+# define my_letoh64(x) (x)
+# define my_htobe64(x) _swab_64_(x)
+# define my_betoh64(x) _swab_64_(x)
+# endif
+# define my_htoles(x) (x)
+# define my_letohs(x) (x)
+# define my_htolei(x) (x)
+# define my_letohi(x) (x)
+# define my_htolel(x) (x)
+# define my_letohl(x) (x)
+# if SHORTSIZE == 1
+# define my_htobes(x) (x)
+# define my_betohs(x) (x)
+# elif SHORTSIZE == 2
+# define my_htobes(x) _swab_16_(x)
+# define my_betohs(x) _swab_16_(x)
+# elif SHORTSIZE == 4
+# define my_htobes(x) _swab_32_(x)
+# define my_betohs(x) _swab_32_(x)
+# elif SHORTSIZE == 8
+# define my_htobes(x) _swab_64_(x)
+# define my_betohs(x) _swab_64_(x)
+# else
+# define PERL_NEED_MY_HTOBES
+# define PERL_NEED_MY_BETOHS
+# endif
+# if INTSIZE == 1
+# define my_htobei(x) (x)
+# define my_betohi(x) (x)
+# elif INTSIZE == 2
+# define my_htobei(x) _swab_16_(x)
+# define my_betohi(x) _swab_16_(x)
+# elif INTSIZE == 4
+# define my_htobei(x) _swab_32_(x)
+# define my_betohi(x) _swab_32_(x)
+# elif INTSIZE == 8
+# define my_htobei(x) _swab_64_(x)
+# define my_betohi(x) _swab_64_(x)
+# else
+# define PERL_NEED_MY_HTOBEI
+# define PERL_NEED_MY_BETOHI
+# endif
+# if LONGSIZE == 1
+# define my_htobel(x) (x)
+# define my_betohl(x) (x)
+# elif LONGSIZE == 2
+# define my_htobel(x) _swab_16_(x)
+# define my_betohl(x) _swab_16_(x)
+# elif LONGSIZE == 4
+# define my_htobel(x) _swab_32_(x)
+# define my_betohl(x) _swab_32_(x)
+# elif LONGSIZE == 8
+# define my_htobel(x) _swab_64_(x)
+# define my_betohl(x) _swab_64_(x)
+# else
+# define PERL_NEED_MY_HTOBEL
+# define PERL_NEED_MY_BETOHL
+# endif
+# define my_htolen(p,n) NOOP
+# define my_letohn(p,n) NOOP
+# define my_htoben(p,n) my_swabn(p,n)
+# define my_betohn(p,n) my_swabn(p,n)
+/*----------------------------------------------------------------------------*/
+# elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 /* big-endian */
+/*----------------------------------------------------------------------------*/
+# define my_htobe16(x) (x)
+# define my_betoh16(x) (x)
+# define my_htobe32(x) (x)
+# define my_betoh32(x) (x)
+# define my_htole16(x) _swab_16_(x)
+# define my_letoh16(x) _swab_16_(x)
+# define my_htole32(x) _swab_32_(x)
+# define my_letoh32(x) _swab_32_(x)
+# ifdef HAS_QUAD
+# define my_htobe64(x) (x)
+# define my_betoh64(x) (x)
+# define my_htole64(x) _swab_64_(x)
+# define my_letoh64(x) _swab_64_(x)
+# endif
+# define my_htobes(x) (x)
+# define my_betohs(x) (x)
+# define my_htobei(x) (x)
+# define my_betohi(x) (x)
+# define my_htobel(x) (x)
+# define my_betohl(x) (x)
+# if SHORTSIZE == 1
+# define my_htoles(x) (x)
+# define my_letohs(x) (x)
+# elif SHORTSIZE == 2
+# define my_htoles(x) _swab_16_(x)
+# define my_letohs(x) _swab_16_(x)
+# elif SHORTSIZE == 4
+# define my_htoles(x) _swab_32_(x)
+# define my_letohs(x) _swab_32_(x)
+# elif SHORTSIZE == 8
+# define my_htoles(x) _swab_64_(x)
+# define my_letohs(x) _swab_64_(x)
+# else
+# define PERL_NEED_MY_HTOLES
+# define PERL_NEED_MY_LETOHS
+# endif
+# if INTSIZE == 1
+# define my_htolei(x) (x)
+# define my_letohi(x) (x)
+# elif INTSIZE == 2
+# define my_htolei(x) _swab_16_(x)
+# define my_letohi(x) _swab_16_(x)
+# elif INTSIZE == 4
+# define my_htolei(x) _swab_32_(x)
+# define my_letohi(x) _swab_32_(x)
+# elif INTSIZE == 8
+# define my_htolei(x) _swab_64_(x)
+# define my_letohi(x) _swab_64_(x)
+# else
+# define PERL_NEED_MY_HTOLEI
+# define PERL_NEED_MY_LETOHI
+# endif
+# if LONGSIZE == 1
+# define my_htolel(x) (x)
+# define my_letohl(x) (x)
+# elif LONGSIZE == 2
+# define my_htolel(x) _swab_16_(x)
+# define my_letohl(x) _swab_16_(x)
+# elif LONGSIZE == 4
+# define my_htolel(x) _swab_32_(x)
+# define my_letohl(x) _swab_32_(x)
+# elif LONGSIZE == 8
+# define my_htolel(x) _swab_64_(x)
+# define my_letohl(x) _swab_64_(x)
+# else
+# define PERL_NEED_MY_HTOLEL
+# define PERL_NEED_MY_LETOHL
+# endif
+# define my_htolen(p,n) my_swabn(p,n)
+# define my_letohn(p,n) my_swabn(p,n)
+# define my_htoben(p,n) NOOP
+# define my_betohn(p,n) NOOP
+/*----------------------------------------------------------------------------*/
+# else /* all other byte-orders */
+/*----------------------------------------------------------------------------*/
+# define PERL_NEED_MY_HTOLE16
+# define PERL_NEED_MY_LETOH16
+# define PERL_NEED_MY_HTOBE16
+# define PERL_NEED_MY_BETOH16
+# define PERL_NEED_MY_HTOLE32
+# define PERL_NEED_MY_LETOH32
+# define PERL_NEED_MY_HTOBE32
+# define PERL_NEED_MY_BETOH32
+# ifdef HAS_QUAD
+# define PERL_NEED_MY_HTOLE64
+# define PERL_NEED_MY_LETOH64
+# define PERL_NEED_MY_HTOBE64
+# define PERL_NEED_MY_BETOH64
+# endif
+# define PERL_NEED_MY_HTOLES
+# define PERL_NEED_MY_LETOHS
+# define PERL_NEED_MY_HTOBES
+# define PERL_NEED_MY_BETOHS
+# define PERL_NEED_MY_HTOLEI
+# define PERL_NEED_MY_LETOHI
+# define PERL_NEED_MY_HTOBEI
+# define PERL_NEED_MY_BETOHI
+# define PERL_NEED_MY_HTOLEL
+# define PERL_NEED_MY_LETOHL
+# define PERL_NEED_MY_HTOBEL
+# define PERL_NEED_MY_BETOHL
+/*----------------------------------------------------------------------------*/
+# endif /* end of byte-order macros */
+/*----------------------------------------------------------------------------*/
+
+#endif /* PERL_CORE */
+
/* Cannot include embed.h here on Win32 as win32.h has not
yet been included and defines some config variables e.g. HAVE_INTERP_INTERN
*/
# else
# define EMBEDMYMALLOC /* for compatibility */
# endif
-START_EXTERN_C
-Malloc_t Perl_malloc (MEM_SIZE nbytes);
-Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size);
-Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes);
-/* 'mfree' rather than 'free', since there is already a 'perl_free'
- * that causes clashes with case-insensitive linkers */
-Free_t Perl_mfree (Malloc_t where);
-END_EXTERN_C
-
-typedef struct perl_mstats perl_mstats_t;
# define safemalloc Perl_malloc
# define safecalloc Perl_calloc
# define saferealloc Perl_realloc
# define safefree Perl_mfree
+# define CHECK_MALLOC_TOO_LATE_FOR_(code) STMT_START { \
+ if (!PL_tainting && MallocCfg_ptr[MallocCfg_cfg_env_read]) \
+ code; \
+ } STMT_END
+# define CHECK_MALLOC_TOO_LATE_FOR(ch) \
+ CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch))
+# define panic_write2(s) write(2, s, strlen(s))
+# define CHECK_MALLOC_TAINT(newval) \
+ CHECK_MALLOC_TOO_LATE_FOR_( \
+ if (newval) { \
+ panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\
+ exit(1); })
+# define MALLOC_CHECK_TAINT(argc,argv,env) STMT_START { \
+ if (doing_taint(argc,argv,env)) { \
+ MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1; \
+ }} STMT_END;
#else /* MYMALLOC */
# define safemalloc safesysmalloc
# define safecalloc safesyscalloc
# define saferealloc safesysrealloc
# define safefree safesysfree
+# define CHECK_MALLOC_TOO_LATE_FOR(ch) ((void)0)
+# define CHECK_MALLOC_TAINT(newval) ((void)0)
+# define MALLOC_CHECK_TAINT(argc,argv,env)
#endif /* MYMALLOC */
+#define TOO_LATE_FOR_(ch,s) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), s)
+#define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "")
+#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
# endif
# ifdef BUGGY_MSC
- # pragma function(memcmp)
+# pragma function(memcmp)
# endif
#else
# ifndef memcmp
# 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
+#endif
#ifndef HAS_BCMP
# ifndef bcmp
# define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */
#endif
-/* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one */
-#if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN)
-# define _SOCKADDR_LEN
+/* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one.
+ * This is important for using IPv6.
+ * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be
+ * a bad idea since it breaks send() and recv(). */
+#if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X)
+# define _SOCKADDR_LEN
#endif
#if defined(HAS_SOCKET) && !defined(VMS) && !defined(WIN32) /* VMS/WIN32 handle sockets via vmsish.h/win32.h */
#endif
/* sockatmark() is so new (2001) that many places might have it hidden
- * behind some -D_BLAH_BLAH_SOURCE guard. */
+ * behind some -D_BLAH_BLAH_SOURCE guard. The __THROW magic is required
+ * e.g. in Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */
#if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO)
+# if defined(__THROW) && defined(__GLIBC__)
+int sockatmark(int) __THROW;
+# else
int sockatmark(int);
+# endif
#endif
#ifdef SETERRNO
# endif
#endif
+#ifndef HAS_QUAD
+# undef PERL_NEED_MY_HTOLE64
+# undef PERL_NEED_MY_LETOH64
+# undef PERL_NEED_MY_HTOBE64
+# undef PERL_NEED_MY_BETOH64
+#endif
+
#if defined(uts) || defined(UTS)
# undef UV_MAX
# define UV_MAX (4294967295u)
# define Perl_atan2 atan2l
# define Perl_pow powl
# define Perl_floor floorl
+# define Perl_ceil ceill
# define Perl_fmod fmodl
# endif
/* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
long double modfl(long double, long double *);
# endif
# else
-# define Perl_modf(x,y) ((long double)modf((double)(x),(double*)(y)))
+# if defined(HAS_AINTL) && defined(HAS_COPYSIGNL)
+ extern long double Perl_my_modfl(long double x, long double *ip);
+# define Perl_modf(x,y) Perl_my_modfl(x,y)
+# endif
# endif
# ifdef HAS_FREXPL
# define Perl_frexp(x,y) frexpl(x,y)
# else
-# define Perl_frexp(x,y) ((long double)frexp((double)(x),y))
+# if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
+ extern long double Perl_my_frexpl(long double x, int *e);
+# define Perl_frexp(x,y) Perl_my_frexpl(x,y)
+# endif
# endif
# ifndef Perl_isnan
# ifdef HAS_ISNANL
# define Perl_atan2 atan2
# define Perl_pow pow
# define Perl_floor floor
+# define Perl_ceil ceil
# define Perl_fmod fmod
# define Perl_modf(x,y) modf(x,y)
# define Perl_frexp(x,y) frexp(x,y)
#endif
-struct perl_mstats {
- UV *nfree;
- UV *ntotal;
- IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
- IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
- IV minbucket;
- /* Level 1 info */
- UV *bucket_mem_size;
- UV *bucket_available_size;
- UV nbuckets;
-};
+#ifdef MYMALLOC
+# include "malloc_ctl.h"
+#endif
+
struct RExC_state_t;
typedef MEM_SIZE STRLEN;
typedef struct ptr_tbl PTR_TBL_t;
typedef struct clone_params CLONE_PARAMS;
-
#include "handy.h"
#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
# endif
# define PERL_FPU_INIT fpsetmask(0);
# else
-# if defined(SIGFPE) && defined(SIG_IGN)
-# define PERL_FPU_INIT signal(SIGFPE, SIG_IGN);
+# if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
+# define PERL_FPU_INIT PL_sigfpe_saved = 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
# endif
#endif
+#ifndef PERL_FPU_PRE_EXEC
+# define PERL_FPU_PRE_EXEC {
+# define PERL_FPU_POST_EXEC }
+#endif
#ifndef PERL_SYS_INIT3
# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
#ifndef SVf
# ifdef CHECK_FORMAT
# define SVf "p"
+# ifndef SVf256
+# define SVf256 SVf
+# endif
# else
# define SVf "_"
# endif
#endif
+#ifndef SVf256
+# define SVf256 ".256"SVf
+#endif
+
#ifndef UVf
# ifdef CHECK_FORMAT
# define UVf UVuf
# endif
#endif
+#ifndef __attribute__format__
+# ifdef CHECK_FORMAT
+# define __attribute__format__(x,y,z) __attribute__((__format__(x,y,z)))
+# else
+# define __attribute__format__(x,y,z)
+# endif
+#endif
+
/* 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.
* that a file is in "binary" mode -- that is, that no translation
* of bytes occurs on read or write operations.
*/
-# define USEMYBINMODE / **/
+# define USEMYBINMODE /**/
+# include <io.h> /* for setmode() prototype */
# define my_binmode(fp, iotype, mode) \
- (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1 ? TRUE : FALSE)
+ (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE)
+#endif
+
+#ifdef __CYGWIN__
+void init_os_extras(void);
#endif
#ifdef UNION_ANY_DEFINITION
#if !defined(OS2) && !defined(MACOS_TRADITIONAL)
# include "iperlsys.h"
#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)
+# define USE_HASH_SEED
+#endif
+
#include "regexp.h"
#include "sv.h"
#include "util.h"
#define DEBUG_r_FLAG 0x00000200 /* 512 */
#define DEBUG_x_FLAG 0x00000400 /* 1024 */
#define DEBUG_u_FLAG 0x00000800 /* 2048 */
+ /* spare */
#define DEBUG_H_FLAG 0x00002000 /* 8192 */
#define DEBUG_X_FLAG 0x00004000 /* 16384 */
#define DEBUG_D_FLAG 0x00008000 /* 32768 */
#define DEBUG_J_FLAG 0x00080000 /* 524288 */
#define DEBUG_v_FLAG 0x00100000 /*1048576 */
#define DEBUG_C_FLAG 0x00200000 /*2097152 */
-#define DEBUG_MASK 0x003FEFFF /* mask of all the standard flags */
+#define DEBUG_A_FLAG 0x00400000 /*4194304 */
+#define DEBUG_q_FLAG 0x00800000 /*8388608 */
+#define DEBUG_MASK 0x00FFEFFF /* 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_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_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
#ifdef DEBUGGING
-# undef YYDEBUG
-# define YYDEBUG 1
-
# define DEBUG_p_TEST DEBUG_p_TEST_
# define DEBUG_s_TEST DEBUG_s_TEST_
# define DEBUG_l_TEST DEBUG_l_TEST_
# define DEBUG_J_TEST DEBUG_J_TEST_
# define DEBUG_v_TEST DEBUG_v_TEST_
# define DEBUG_C_TEST DEBUG_C_TEST_
+# define DEBUG_A_TEST DEBUG_A_TEST_
+# define DEBUG_q_TEST DEBUG_q_TEST_
-# define DEB(a) a
-# define DEBUG(a) if (PL_debug) a
+# define PERL_DEB(a) a
+# define PERL_DEBUG(a) if (PL_debug) a
# define DEBUG_p(a) if (DEBUG_p_TEST) a
# define DEBUG_s(a) if (DEBUG_s_TEST) a
# define DEBUG_l(a) if (DEBUG_l_TEST) a
# define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
# define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a)
# define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a)
+# define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a)
+# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
#else /* DEBUGGING */
# define DEBUG_J_TEST (0)
# define DEBUG_v_TEST (0)
# define DEBUG_C_TEST (0)
+# define DEBUG_A_TEST (0)
+# define DEBUG_q_TEST (0)
-# define DEB(a)
-# define DEBUG(a)
+# define PERL_DEB(a)
+# define PERL_DEBUG(a)
# define DEBUG_p(a)
# define DEBUG_s(a)
# define DEBUG_l(a)
# define DEBUG_R(a)
# define DEBUG_v(a)
# define DEBUG_C(a)
+# define DEBUG_A(a)
+# define DEBUG_q(a)
#endif /* DEBUGGING */
+#define DEBUG_SCOPE(where) \
+ DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n", \
+ where, PL_scopestack_ix, __FILE__, __LINE__)));
+
+
+
+
/* These constants should be used in preference to raw characters
* when using magic. Note that some perl guts still assume
* certain character properties of these constants, namely that
#define PERL_MAGIC_ext '~' /* Available for use by extensions */
-#define YYMAXDEPTH 300
-
#ifndef assert /* <assert.h> might have been included somehow */
-#ifdef DEBUGGING
-#define assert(what) DEB( { \
- if (!(what)) { \
- Perl_croak(aTHX_ "Assertion " STRINGIFY(what) " failed: file \"%s\", line %d", \
- __FILE__, __LINE__); \
- PerlProc_exit(1); \
- }})
-#else
-#define assert(what) DEB( { \
- if (!(what)) { \
- Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d", \
- __FILE__, __LINE__); \
- PerlProc_exit(1); \
- }})
-#endif
+#define assert(what) PERL_DEB( \
+ ((what) ? ((void) 0) : \
+ (Perl_croak(aTHX_ "Assertion " STRINGIFY(what) " failed: file \"%s\", line %d", \
+ __FILE__, __LINE__), \
+ PerlProc_exit(1), \
+ (void) 0)))
#endif
struct ufuncs {
/* NeXT has problems with crt0.o globals */
#if defined(__DYNAMIC__) && \
- (defined(NeXT) || defined(__NeXT__) || defined(__APPLE__))
+ (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN))
# if defined(NeXT) || defined(__NeXT)
# include <mach-o/dyld.h>
# define environ (*environ_pointer)
EXT char *** environ_pointer;
# else
-# if defined(__APPLE__) && defined(PERL_CORE)
+# if defined(PERL_DARWIN) && defined(PERL_CORE)
# include <crt_externs.h> /* for the env array */
# define environ (*_NSGetEnviron())
# endif
/* handy constants */
EXTCONST char PL_warn_uninit[]
- INIT("Use of uninitialized value%s%s");
+ INIT("Use of uninitialized value%s%s%s");
EXTCONST char PL_warn_nosemi[]
INIT("Semicolon seems to be missing");
EXTCONST char PL_warn_reserved[]
INIT("\"my\" variable %s can't be in a package");
EXTCONST char PL_no_localize_ref[]
INIT("Can't localize through a reference");
+#ifdef PERL_MALLOC_WRAP
+EXTCONST char PL_memory_wrap[]
+ INIT("panic: memory wrap");
+#endif
EXTCONST char PL_uuemap[65]
INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
/*****************************************************************************/
/* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
+#ifdef __Lynx__
+/* LynxOS defines these in scsi.h which is included via ioctl.h */
+#ifdef FORMAT
+#undef FORMAT
+#endif
+#ifdef SPACE
+#undef SPACE
+#endif
+#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"
#define LEX_NOTPARSING 11 /* borrowed from toke.c */
XATTRTERM,
XTERMBLOCK,
XTERMORDORDOR /* evil hack */
+ /* update exp_name[] in toke.c if adding to this enum */
} expectation;
enum { /* pass one of these to get_vtbl */
#define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */
#define HINT_UTF8 0x00800000 /* utf8 pragma */
+/* assertions pragma */
#define HINT_ASSERTING 0x01000000
+#define HINT_ASSERTIONSSEEN 0x02000000
/* The following are stored in $sort::hints, not in PL_hints */
#define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */
#undef PERLVARI
#undef PERLVARIC
+/* Types used by pack/unpack */
+typedef enum {
+ e_no_len, /* no length */
+ e_number, /* number, [] */
+ e_star /* asterisk */
+} howlen_t;
+
+typedef struct {
+ char* patptr; /* current template char */
+ char* patend; /* one after last char */
+ char* grpbeg; /* 1st char of ()-group */
+ char* grpend; /* end of ()-group */
+ I32 code; /* template code (!<>) */
+ I32 length; /* length/repeat count */
+ howlen_t howlen; /* how length is given */
+ int level; /* () nesting level */
+ U32 flags; /* /=4, comma=2, pack=1 */
+ /* and group modifiers */
+} tempsym_t;
+
#include "thread.h"
#include "pp.h"
#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
#define IN_LOCALE \
- (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+ (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
bool was_local = PL_numeric_local && IN_LOCALE; \
#if !defined(Strtoul) && defined(HAS_STRTOUL)
# define Strtoul strtoul
#endif
+#if !defined(Strtoul) && defined(HAS_STRTOL) /* Last resort. */
+# define Strtoul(s, e, b) strchr((s), '-') ? ULONG_MAX : (unsigned long)strtol((s), (e), (b))
+#endif
#ifndef Atoul
# define Atoul(s) Strtoul(s, (char **)NULL, 10)
#endif
Zero(my_cxtp, 1, my_cxt_t); \
sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+
/* This macro must be used to access members of the my_cxt_t structure.
* e.g. MYCXT.some_data */
#define MY_CXT (*my_cxtp)
#define dMY_CXT_SV dNOOP
#define dMY_CXT dNOOP
#define MY_CXT_INIT NOOP
+#define MY_CXT_CLONE NOOP
#define MY_CXT my_cxt
#define pMY_CXT void
# include <fcntl.h>
#endif
+#ifdef __Lynx__
+# include <fcntl.h>
+#endif
+
#ifdef I_SYS_FILE
# include <sys/file.h>
#endif
#if O_TEXT != O_BINARY
/* If you have different O_TEXT and O_BINARY and you are a CLRF shop,
* that is, you are somehow DOSish. */
-# if defined(__BEOS__) || defined(__VOS__)
+# if defined(__BEOS__) || defined(__VOS__) || defined(__CYGWIN__)
/* BeOS has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect;
* BeOS is always UNIXoid (LF), not DOSish (CRLF). */
/* VOS has O_TEXT != O_BINARY, and they have effect,
# define PERL_MOUNT_NOSUID M_NOSUID
#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(MOUNT_NOEXEC)
+# define PERL_MOUNT_NOEXEC MOUNT_NOEXEC
+#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(MNT_NOEXEC)
+# define PERL_MOUNT_NOEXEC MNT_NOEXEC
+#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(MS_NOEXEC)
+# define PERL_MOUNT_NOEXEC MS_NOEXEC
+#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(M_NOEXEC)
+# define PERL_MOUNT_NOEXEC M_NOEXEC
+#endif
+
#endif /* IAMSUID */
#ifdef I_LIBUTIL
/* Input flags: */
#define PERL_SCAN_ALLOW_UNDERSCORES 0x01 /* grok_??? accept _ in numbers */
#define PERL_SCAN_DISALLOW_PREFIX 0x02 /* grok_??? reject 0x in hex etc */
+#define PERL_SCAN_SILENT_ILLDIGIT 0x04 /* grok_??? not warn about illegal digits */
/* Output flags: */
#define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */
# define PIPESOCK_MODE
#endif
+#ifndef SOCKET_OPEN_MODE
+# define SOCKET_OPEN_MODE PIPESOCK_MODE
+#endif
+
+#ifndef PIPE_OPEN_MODE
+# define PIPE_OPEN_MODE PIPESOCK_MODE
+#endif
+
#define PERL_MAGIC_UTF8_CACHESIZE 2
#define PERL_UNICODE_STDIN_FLAG 0x0001
#define PERL_UNICODE_STDOUT_FLAG 0x0002
#define PERL_UNICODE_STDERR_FLAG 0x0004
-#define PERL_UNICODE_STD_FLAG 0x0007
#define PERL_UNICODE_IN_FLAG 0x0008
#define PERL_UNICODE_OUT_FLAG 0x0010
-#define PERL_UNICODE_INOUT_FLAG 0x0018
-#define PERL_UNICODE_ARGV_FLAG 0x0020 /* For @ARGV? */
+#define PERL_UNICODE_ARGV_FLAG 0x0020
#define PERL_UNICODE_LOCALE_FLAG 0x0040
#define PERL_UNICODE_WIDESYSCALLS_FLAG 0x0080 /* for Sarathy */
-#define PERL_UNICODE_DEFAULT_FLAGS \
+#define PERL_UNICODE_STD_FLAG \
+ (PERL_UNICODE_STDIN_FLAG | \
+ PERL_UNICODE_STDOUT_FLAG | \
+ PERL_UNICODE_STDERR_FLAG)
+
+#define PERL_UNICODE_INOUT_FLAG \
+ (PERL_UNICODE_IN_FLAG | \
+ PERL_UNICODE_OUT_FLAG)
+
+#define PERL_UNICODE_DEFAULT_FLAGS \
(PERL_UNICODE_STD_FLAG | \
PERL_UNICODE_INOUT_FLAG | \
PERL_UNICODE_LOCALE_FLAG)
# define PERL_BLOCKSIG_UNBLOCK(set) NOOP
#endif
+/* Use instead of abs() since abs() forces its argument to be an int,
+ * but also beware since this evaluates its argument twice, so no x++. */
+#define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
+
/* and finally... */
#define PERL_PATCHLEVEL_H_IMPLICIT
#include "patchlevel.h"
HAS_UALARM
HAS_USLEEP
- HAS_NANOSLEEP
HAS_SETITIMER
HAS_GETITIMER
https://perl5.git.perl.org / perl5.git / blobdiff