X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=93034190ec82ddd701c21ff13c55ec22ed905096;hb=e5c3f8982a1650ad4c25a05c41a9038ce21a512c;hp=62f43a276676caeb64b1c3ed81d9535d889fade6;hpb=4bb101f2758f169969171dfe6b70f68a406dcc1e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 62f43a2..9303419 100644 --- a/perl.h +++ b/perl.h @@ -1,7 +1,7 @@ /* perl.h * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, by Larry Wall and others + * 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. @@ -73,12 +73,23 @@ /* 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 @@ -117,7 +128,7 @@ #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)) @@ -196,6 +207,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # 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 @@ -204,7 +219,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); * 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 @@ -264,7 +279,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # 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 @@ -434,6 +449,241 @@ int usleep(unsigned int); # 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 */ @@ -470,28 +720,42 @@ int usleep(unsigned int); # 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_ "Too late for \"-%c\" option%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 @@ -551,7 +815,7 @@ typedef struct perl_mstats perl_mstats_t; # endif # endif # ifdef BUGGY_MSC - # pragma function(memcmp) +# pragma function(memcmp) # endif #else # ifndef memcmp @@ -571,11 +835,13 @@ typedef struct perl_mstats perl_mstats_t; # 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 @@ -647,9 +913,12 @@ typedef struct perl_mstats perl_mstats_t; # 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 */ @@ -679,9 +948,14 @@ typedef struct perl_mstats perl_mstats_t; #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 @@ -1052,6 +1326,13 @@ typedef UVTYPE UV; # 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) @@ -1243,6 +1524,7 @@ typedef NVTYPE NV; # 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 */ @@ -1313,6 +1595,7 @@ long double modfl(long double, long double *); # 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) @@ -1665,17 +1948,10 @@ int isnan(double d); #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; @@ -1733,7 +2009,6 @@ typedef struct ptr_tbl_ent PTR_TBL_ENT_t; 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) @@ -1916,13 +2191,20 @@ typedef struct clone_params CLONE_PARAMS; # 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) @@ -2111,11 +2393,18 @@ typedef pthread_key_t perl_key; #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 @@ -2140,6 +2429,14 @@ typedef pthread_key_t perl_key; # 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. @@ -2167,7 +2464,7 @@ typedef pthread_key_t perl_key; * 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 /* for setmode() prototype */ # define my_binmode(fp, iotype, mode) \ (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE) @@ -2216,6 +2513,17 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ #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" @@ -2434,6 +2742,7 @@ Gid_t getegid (void); #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 */ @@ -2443,7 +2752,9 @@ Gid_t getegid (void); #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 @@ -2470,13 +2781,12 @@ Gid_t getegid (void); # 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_ @@ -2499,9 +2809,11 @@ Gid_t getegid (void); # 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 @@ -2537,6 +2849,8 @@ Gid_t getegid (void); # 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 */ @@ -2562,9 +2876,11 @@ Gid_t getegid (void); # 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) @@ -2586,9 +2902,18 @@ Gid_t getegid (void); # 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 @@ -2640,24 +2965,13 @@ Gid_t getegid (void); #define PERL_MAGIC_ext '~' /* Available for use by extensions */ -#define YYMAXDEPTH 300 - #ifndef assert /* 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 { @@ -2887,13 +3201,13 @@ typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX); /* 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 # define environ (*environ_pointer) EXT char *** environ_pointer; # else -# if defined(__APPLE__) && defined(PERL_CORE) +# if defined(PERL_DARWIN) && defined(PERL_CORE) # include /* for the env array */ # define environ (*_NSGetEnviron()) # endif @@ -2914,7 +3228,7 @@ START_EXTERN_C /* 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[] @@ -2947,6 +3261,10 @@ EXTCONST char PL_no_myglob[] 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[\\]^_"); @@ -3175,6 +3493,23 @@ END_EXTERN_C /*****************************************************************************/ /* 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 */ @@ -3375,11 +3710,12 @@ typedef struct { char* patend; /* one after last char */ char* grpbeg; /* 1st char of ()-group */ char* grpend; /* end of ()-group */ - I32 code; /* template code (!) */ + 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" @@ -3780,7 +4116,7 @@ typedef struct am_table_short AMTS; #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; \ @@ -3862,6 +4198,9 @@ typedef struct am_table_short AMTS; #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 @@ -4057,6 +4396,10 @@ typedef struct am_table_short AMTS; # include #endif +#ifdef __Lynx__ +# include +#endif + #ifdef I_SYS_FILE # include #endif @@ -4084,7 +4427,7 @@ int flock(int fd, int op); #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, @@ -4141,6 +4484,19 @@ int flock(int fd, int op); # 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 @@ -4205,6 +4561,14 @@ extern void moncontrol(int); # 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 @@ -4308,7 +4672,6 @@ extern void moncontrol(int); HAS_UALARM HAS_USLEEP - HAS_NANOSLEEP HAS_SETITIMER HAS_GETITIMER