X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=93034190ec82ddd701c21ff13c55ec22ed905096;hb=e5c3f8982a1650ad4c25a05c41a9038ce21a512c;hp=5c13a7dae2c0739e8670564001810d7830997cf8;hpb=d672126634c5e568812ed35d4c8ea53a9a55ee4c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 5c13a7d..9303419 100644 --- a/perl.h +++ b/perl.h @@ -1,6 +1,7 @@ /* 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. @@ -36,17 +37,6 @@ # include "config.h" #endif -#if defined(USE_ITHREADS) && defined(USE_5005THREADS) -# include "error: USE_ITHREADS and USE_5005THREADS are incompatible" -#endif - -/* XXX This next guard can disappear if the sources are revised - to use USE_5005THREADS throughout. -- A.D 1/6/2000 -*/ -#if defined(USE_ITHREADS) && defined(USE_5005THREADS) -# include "error: USE_ITHREADS and USE_5005THREADS are incompatible" -#endif - /* See L for detailed notes on * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */ @@ -69,12 +59,6 @@ # endif #endif -#ifdef USE_5005THREADS -# ifndef PERL_IMPLICIT_CONTEXT -# define PERL_IMPLICIT_CONTEXT -# endif -#endif - #if defined(MULTIPLICITY) # ifndef PERL_IMPLICIT_CONTEXT # define PERL_IMPLICIT_CONTEXT @@ -89,27 +73,30 @@ /* 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 -# ifdef USE_5005THREADS -struct perl_thread; -# define pTHX register struct perl_thread *thr PERL_UNUSED_DECL -# define aTHX thr -# define dTHR dNOOP /* only backward compatibility */ -# define dTHXa(a) pTHX = (struct perl_thread*)a -# else -# ifndef MULTIPLICITY -# define MULTIPLICITY -# endif -# define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL -# define aTHX my_perl -# define dTHXa(a) pTHX = (PerlInterpreter*)a +# ifndef MULTIPLICITY +# define MULTIPLICITY # endif +# define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL +# define aTHX my_perl +# define dTHXa(a) pTHX = (PerlInterpreter*)a # define dTHX pTHX = PERL_GET_THX # define pTHX_ pTHX, # define aTHX_ aTHX, @@ -141,7 +128,7 @@ struct perl_thread; #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)) @@ -220,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 @@ -228,12 +219,12 @@ 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(__cplusplus) +# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ # define STMT_END ) # else /* Now which other defined()s do we need here ??? */ -# if (VOIDFLAGS) && (defined(sun) || defined(__sun__)) +# if (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) # define STMT_START if (1) # define STMT_END else (void)0 # else @@ -288,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 @@ -361,8 +352,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); /* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that pthread.h must be included before all other header files. */ -#if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) \ - && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) +#if defined(USE_ITHREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) # include #endif @@ -459,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 */ @@ -495,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 @@ -576,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 @@ -596,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 @@ -672,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 */ @@ -684,18 +928,7 @@ typedef struct perl_mstats perl_mstats_t; # define INCLUDE_PROTOTYPES /* for */ # define PERL_SOCKS_NEED_PROTOTYPES # endif -# ifdef USE_5005THREADS -# define PERL_USE_THREADS /* store our value */ -# undef USE_5005THREADS -# endif # include -# ifdef USE_5005THREADS -# undef USE_5005THREADS /* socks.h does this on its own */ -# endif -# ifdef PERL_USE_THREADS -# define USE_5005THREADS /* restore our value */ -# undef PERL_USE_THREADS -# endif # ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */ # undef INCLUDE_PROTOTYPES # undef PERL_SOCKS_NEED_PROTOTYPES @@ -715,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 @@ -730,19 +968,37 @@ int sockatmark(int); set_errno(errcode); \ set_vaxc_errno(vmserrcode); \ } STMT_END +# define LIB_INVARG LIB$_INVARG +# define RMS_DIR RMS$_DIR +# define RMS_FAC RMS$_FAC +# define RMS_FEX RMS$_FEX +# define RMS_FNF RMS$_FNF +# define RMS_IFI RMS$_IFI +# define RMS_ISI RMS$_ISI +# define RMS_PRV RMS$_PRV +# define SS_ACCVIO SS$_ACCVIO +# define SS_DEVOFFLINE SS$_DEVOFFLINE +# define SS_IVCHAN SS$_IVCHAN +# define SS_NORMAL SS$_NORMAL #else # define SETERRNO(errcode,vmserrcode) (errno = (errcode)) -#endif - -#ifdef USE_5005THREADS -# define ERRSV (thr->errsv) -# define DEFSV THREADSV(0) -# define SAVE_DEFSV save_threadsv(0) -#else -# define ERRSV GvSV(PL_errgv) -# define DEFSV GvSV(PL_defgv) -# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) -#endif /* USE_5005THREADS */ +# define LIB_INVARG 0 +# define RMS_DIR 0 +# define RMS_FAC 0 +# define RMS_FEX 0 +# define RMS_FNF 0 +# define RMS_IFI 0 +# define RMS_ISI 0 +# define RMS_PRV 0 +# define SS_ACCVIO 0 +# define SS_DEVOFFLINE 0 +# define SS_IVCHAN 0 +# define SS_NORMAL 0 +#endif + +#define ERRSV GvSV(PL_errgv) +#define DEFSV GvSV(PL_defgv) +#define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */ @@ -1070,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) @@ -1130,8 +1393,10 @@ typedef UVTYPE UV; # 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) + 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 @@ -1186,6 +1451,29 @@ typedef UVTYPE UV; # 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 + */ + +#ifdef I_LIMITS +# include +#endif + +#ifdef I_VALUES +# if !(defined(DBL_MIN) && defined(DBL_MAX) && defined(I_LIMITS)) +# include +# 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 @@ -1217,7 +1505,7 @@ typedef NVTYPE NV; # endif # ifdef LDBL_MAX # define NV_MAX LDBL_MAX -# define NV_MIN LDBL_MIN +/* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */ # else # ifdef HUGE_VALL # define NV_MAX HUGE_VALL @@ -1236,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 */ @@ -1247,12 +1536,18 @@ typedef NVTYPE NV; 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 @@ -1284,7 +1579,7 @@ long double modfl(long double, long double *); # ifdef DBL_EPSILON # define NV_EPSILON DBL_EPSILON # endif -# ifdef DBL_MAX +# ifdef DBL_MAX /* XXX Does DBL_MAX imply having DBL_MIN? */ # define NV_MAX DBL_MAX # define NV_MIN DBL_MIN # else @@ -1300,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) @@ -1307,6 +1603,13 @@ long double modfl(long double, long double *); /* rumor has it that Win32 has _fpclass() */ +/* SGI has fpclassl... but not with the same result values, + * and it's via a typedef (not via #define), so will need to redo Configure + * to use. Not worth the trouble, IMO, at least until the below is used + * more places. Also has fp_class_l, BTW, via fp_class.h. Feel free to check + * with me for the SGI manpages, SGI testing, etcetera, if you want to + * try getting this to work with IRIX. - Allen */ + #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL)) # ifdef I_IEEFP # include @@ -1448,7 +1751,8 @@ int isnan(double d); * it is however best to use the native implementation of atof. * You can experiment with using your native one by -DUSE_PERL_ATOF=0. * Some good tests to try out with either setting are t/base/num.t, - * t/op/numconvert.t, and t/op/pack.t. */ + * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles + * you may need to be using a different function than atof! */ #ifndef USE_PERL_ATOF # ifndef _UNICOS @@ -1481,11 +1785,9 @@ int isnan(double d); #ifdef I_LIMITS /* Needed for cast_xxx() functions below. */ # include -#else -#ifdef I_VALUES -# include -#endif #endif +/* Included values.h above if necessary; still including limits.h down here, + * despite doing above, because math.h might have overriden... XXX - Allen */ /* * Try to figure out max and min values for the integral types. THE CORRECT @@ -1646,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; @@ -1714,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) @@ -1897,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) @@ -1917,37 +2218,34 @@ typedef struct clone_params CLONE_PARAMS; # ifdef PATH_MAX # ifdef _POSIX_PATH_MAX # if PATH_MAX > _POSIX_PATH_MAX -/* MAXPATHLEN is supposed to include the final null character, - * as opposed to PATH_MAX and _POSIX_PATH_MAX. */ -# define MAXPATHLEN (PATH_MAX+1) +/* POSIX 1990 (and pre) was ambiguous about whether PATH_MAX + * included the null byte or not. Later amendments of POSIX, + * XPG4, the Austin Group, and the Single UNIX Specification + * all explicitly include the null byte in the PATH_MAX. + * Ditto for _POSIX_PATH_MAX. */ +# define MAXPATHLEN PATH_MAX # else -# define MAXPATHLEN (_POSIX_PATH_MAX+1) +# define MAXPATHLEN _POSIX_PATH_MAX # endif # else # define MAXPATHLEN (PATH_MAX+1) # endif # else # ifdef _POSIX_PATH_MAX -# define MAXPATHLEN (_POSIX_PATH_MAX+1) +# define MAXPATHLEN _POSIX_PATH_MAX # else # define MAXPATHLEN 1024 /* Err on the large side. */ # endif # endif #endif -/* - * USE_5005THREADS needs to be after unixish.h as includes +/* USE_5005THREADS needs to be after unixish.h as includes * which defines NSIG - which will stop inclusion of * this results in many functions being undeclared which bothers C++ * May make sense to have threads after "*ish.h" anyway */ -#if defined(USE_5005THREADS) || defined(USE_ITHREADS) -# if defined(USE_5005THREADS) - /* pending resolution of licensing issues, we avoid the erstwhile - * atomic.h everywhere */ -# define EMULATE_ATOMIC_REFCOUNTS -# endif +#if defined(USE_ITHREADS) # ifdef NETWARE # include # else @@ -1982,7 +2280,7 @@ typedef pthread_key_t perl_key; # endif /* WIN32 */ # endif /* FAKE_THREADS */ #endif /* NETWARE */ -#endif /* USE_5005THREADS || USE_ITHREADS */ +#endif /* USE_ITHREADS */ #if defined(WIN32) # include "win32.h" @@ -2086,24 +2384,27 @@ typedef pthread_key_t perl_key; #endif #if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX) -# ifdef USE_5005THREADS -# define PERL_GET_THX ((struct perl_thread *)PERL_GET_CONTEXT) -# else # ifdef MULTIPLICITY # define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT) # endif -# endif # define PERL_SET_THX(t) PERL_SET_CONTEXT(t) #endif #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 @@ -2128,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. @@ -2155,9 +2464,14 @@ 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(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 @@ -2168,17 +2482,12 @@ union any { I32 any_i32; IV any_iv; long any_long; + bool any_bool; void (*any_dptr) (void*); void (*any_dxptr) (pTHX_ void*); }; #endif -#ifdef USE_5005THREADS -#define ARGSproto struct perl_thread *thr -#else -#define ARGSproto -#endif /* USE_5005THREADS */ - typedef I32 (*filter_t) (pTHX_ int, SV *, int); #define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) @@ -2204,11 +2513,23 @@ 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" #include "form.h" #include "gv.h" +#include "pad.h" #include "cv.h" #include "opnames.h" #include "op.h" @@ -2421,7 +2742,7 @@ Gid_t getegid (void); #define DEBUG_r_FLAG 0x00000200 /* 512 */ #define DEBUG_x_FLAG 0x00000400 /* 1024 */ #define DEBUG_u_FLAG 0x00000800 /* 2048 */ -#define DEBUG_L_FLAG 0x00001000 /* 4096 */ + /* spare */ #define DEBUG_H_FLAG 0x00002000 /* 8192 */ #define DEBUG_X_FLAG 0x00004000 /* 16384 */ #define DEBUG_D_FLAG 0x00008000 /* 32768 */ @@ -2430,7 +2751,10 @@ Gid_t getegid (void); #define DEBUG_R_FLAG 0x00040000 /* 262144 */ #define DEBUG_J_FLAG 0x00080000 /* 524288 */ #define DEBUG_v_FLAG 0x00100000 /*1048576 */ -#define DEBUG_MASK 0x001FFFFF /* mask of all the standard flags */ +#define DEBUG_C_FLAG 0x00200000 /*2097152 */ +#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 @@ -2448,7 +2772,6 @@ Gid_t getegid (void); # 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_L_TEST_ (PL_debug & DEBUG_L_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) @@ -2457,12 +2780,13 @@ Gid_t getegid (void); # 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_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_ @@ -2475,18 +2799,21 @@ Gid_t getegid (void); # define DEBUG_r_TEST DEBUG_r_TEST_ # define DEBUG_x_TEST DEBUG_x_TEST_ # define DEBUG_u_TEST DEBUG_u_TEST_ -# define DEBUG_L_TEST DEBUG_L_TEST_ # define DEBUG_H_TEST DEBUG_H_TEST_ # define DEBUG_X_TEST DEBUG_X_TEST_ +# define DEBUG_Xv_TEST DEBUG_Xv_TEST_ # define DEBUG_D_TEST DEBUG_D_TEST_ # define DEBUG_S_TEST DEBUG_S_TEST_ # define DEBUG_T_TEST DEBUG_T_TEST_ # define DEBUG_R_TEST DEBUG_R_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 @@ -2511,20 +2838,19 @@ Gid_t getegid (void); # define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a) # define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a) # define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a) -# define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a) # define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a) # define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a) +# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a) # define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a) -# ifdef USE_5005THREADS -# define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a) -# else -# define DEBUG_S(a) -# endif +# define DEBUG_S(a) # define DEBUG_T(a) DEBUG__(DEBUG_T_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 */ @@ -2540,18 +2866,21 @@ Gid_t getegid (void); # define DEBUG_r_TEST (0) # define DEBUG_x_TEST (0) # define DEBUG_u_TEST (0) -# define DEBUG_L_TEST (0) # define DEBUG_H_TEST (0) # define DEBUG_X_TEST (0) +# define DEBUG_Xv_TEST (0) # define DEBUG_D_TEST (0) # define DEBUG_S_TEST (0) # define DEBUG_T_TEST (0) # define DEBUG_R_TEST (0) # 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) @@ -2564,17 +2893,27 @@ Gid_t getegid (void); # define DEBUG_r(a) # define DEBUG_x(a) # define DEBUG_u(a) -# define DEBUG_L(a) # define DEBUG_H(a) # define DEBUG_X(a) +# define DEBUG_Xv(a) # define DEBUG_D(a) # define DEBUG_S(a) # define DEBUG_T(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 @@ -2614,6 +2953,8 @@ Gid_t getegid (void); #define PERL_MAGIC_uvar 'U' /* Available for use by extensions */ #define PERL_MAGIC_uvar_elem 'u' /* Reserved for use by extensions */ #define PERL_MAGIC_vec 'v' /* vec() lvalue */ +#define PERL_MAGIC_vstring 'V' /* SV was vstring literal */ +#define PERL_MAGIC_utf8 'w' /* Cached UTF-8 information */ #define PERL_MAGIC_substr 'x' /* substr() lvalue */ #define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable / smart parameter vivification */ @@ -2624,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 { @@ -2833,10 +3163,8 @@ typedef Sighandler_t Sigsave_t; # ifndef register # define register # endif -# define PAD_SV(po) pad_sv(po) # define RUNOPS_DEFAULT Perl_runops_debug #else -# define PAD_SV(po) PL_curpad[po] # define RUNOPS_DEFAULT Perl_runops_standard #endif @@ -2873,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 @@ -2900,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[] @@ -2931,6 +3259,12 @@ EXTCONST char PL_no_func[] INIT("The %s function is unimplemented"); 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[\\]^_"); @@ -3159,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 */ @@ -3171,7 +3522,9 @@ typedef enum { XBLOCK, XATTRBLOCK, XATTRTERM, - XTERMBLOCK + XTERMBLOCK, + XTERMORDORDOR /* evil hack */ + /* update exp_name[] in toke.c if adding to this enum */ } expectation; enum { /* pass one of these to get_vtbl */ @@ -3201,28 +3554,28 @@ enum { /* pass one of these to get_vtbl */ want_vtbl_collxfrm, want_vtbl_amagic, want_vtbl_amagicelem, -#ifdef USE_5005THREADS - want_vtbl_mutex, -#endif want_vtbl_regdata, want_vtbl_regdatum, - want_vtbl_backref + want_vtbl_backref, + want_vtbl_utf8 }; /* Note: the lowest 8 bits are reserved for stuffing into op->op_private */ #define HINT_PRIVATE_MASK 0x000000ff -#define HINT_INTEGER 0x00000001 -#define HINT_STRICT_REFS 0x00000002 -#define HINT_LOCALE 0x00000004 -#define HINT_BYTES 0x00000008 +#define HINT_INTEGER 0x00000001 /* integer pragma */ +#define HINT_STRICT_REFS 0x00000002 /* strict pragma */ +#define HINT_LOCALE 0x00000004 /* locale pragma */ +#define HINT_BYTES 0x00000008 /* bytes pragma */ /* #define HINT_notused10 0x00000010 */ /* Note: 20,40,80 used for NATIVE_HINTS */ + /* currently defined by vms/vmsish.h */ #define HINT_BLOCK_SCOPE 0x00000100 -#define HINT_STRICT_SUBS 0x00000200 -#define HINT_STRICT_VARS 0x00000400 +#define HINT_STRICT_SUBS 0x00000200 /* strict pragma */ +#define HINT_STRICT_VARS 0x00000400 /* strict pragma */ +/* The HINT_NEW_* constants are used by the overload pragma */ #define HINT_NEW_INTEGER 0x00001000 #define HINT_NEW_FLOAT 0x00002000 #define HINT_NEW_BINARY 0x00004000 @@ -3230,12 +3583,17 @@ enum { /* pass one of these to get_vtbl */ #define HINT_NEW_RE 0x00010000 #define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */ -#define HINT_RE_TAINT 0x00100000 -#define HINT_RE_EVAL 0x00200000 +#define HINT_RE_TAINT 0x00100000 /* re pragma */ +#define HINT_RE_EVAL 0x00200000 /* re pragma */ + +#define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */ +#define HINT_UTF8 0x00800000 /* utf8 pragma */ -#define HINT_FILETEST_ACCESS 0x00400000 -#define HINT_UTF8 0x00800000 +/* 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 */ #define HINT_SORT_QUICKSORT 0x00000001 #define HINT_SORT_MERGESORT 0x00000002 @@ -3317,9 +3675,7 @@ struct perl_vars *PL_VarsPtr; */ struct interpreter { -# ifndef USE_5005THREADS -# include "thrdvar.h" -# endif +# include "thrdvar.h" # include "intrpvar.h" /* * The following is a buffer where new variables must @@ -3334,21 +3690,7 @@ struct interpreter { }; #endif /* MULTIPLICITY */ -#ifdef USE_5005THREADS -/* If we have threads define a struct with all the variables - * that have to be per-thread - */ - - -struct perl_thread { -#include "thrdvar.h" -}; - -typedef struct perl_thread *Thread; - -#else typedef void *Thread; -#endif /* Done with PERLVAR macros for now ... */ #undef PERLVAR @@ -3356,6 +3698,26 @@ typedef void *Thread; #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" @@ -3401,9 +3763,7 @@ typedef void *Thread; #if !defined(MULTIPLICITY) START_EXTERN_C # include "intrpvar.h" -# ifndef USE_5005THREADS -# include "thrdvar.h" -# endif +# include "thrdvar.h" END_EXTERN_C #endif @@ -3493,15 +3853,11 @@ EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm), EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar), MEMBER_TO_FPTR(Perl_magic_setuvar), 0, 0, 0}; -#ifdef USE_5005THREADS -EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, - MEMBER_TO_FPTR(Perl_magic_mutexfree)}; -#endif /* USE_5005THREADS */ EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem), MEMBER_TO_FPTR(Perl_magic_setdefelem), 0, 0, 0}; -EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)}; +EXT MGVTBL PL_vtbl_regexp = {0, MEMBER_TO_FPTR(Perl_magic_setregexp),0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)}; EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0}; EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get), MEMBER_TO_FPTR(Perl_magic_regdatum_set), 0, 0, 0}; @@ -3523,6 +3879,10 @@ EXT MGVTBL PL_vtbl_backref = {0, 0, EXT MGVTBL PL_vtbl_ovrld = {0, 0, 0, 0, MEMBER_TO_FPTR(Perl_magic_freeovrld)}; +EXT MGVTBL PL_vtbl_utf8 = {0, + MEMBER_TO_FPTR(Perl_magic_setutf8), + 0, 0, 0}; + #else /* !DOINIT */ EXT MGVTBL PL_vtbl_sv; @@ -3548,10 +3908,6 @@ EXT MGVTBL PL_vtbl_fm; EXT MGVTBL PL_vtbl_uvar; EXT MGVTBL PL_vtbl_ovrld; -#ifdef USE_5005THREADS -EXT MGVTBL PL_vtbl_mutex; -#endif /* USE_5005THREADS */ - EXT MGVTBL PL_vtbl_defelem; EXT MGVTBL PL_vtbl_regexp; EXT MGVTBL PL_vtbl_regdata; @@ -3565,6 +3921,7 @@ EXT MGVTBL PL_vtbl_amagic; EXT MGVTBL PL_vtbl_amagicelem; EXT MGVTBL PL_vtbl_backref; +EXT MGVTBL PL_vtbl_utf8; #endif /* !DOINIT */ @@ -3720,8 +4077,8 @@ typedef struct am_table_short AMTS; #define PERLDB_ALL (PERLDBf_SUB | PERLDBf_LINE | \ PERLDBf_NOOPT | PERLDBf_INTER | \ PERLDBf_SUBLINE| PERLDBf_SINGLE| \ - PERLDBf_NAMEEVAL| PERLDBf_NAMEANON) - /* No _NONAME, _GOTO */ + PERLDBf_NAMEEVAL| PERLDBf_NAMEANON ) + /* No _NONAME, _GOTO, _ASSERTION */ #define PERLDBf_SUB 0x01 /* Debug sub enter/exit */ #define PERLDBf_LINE 0x02 /* Keep line # */ #define PERLDBf_NOOPT 0x04 /* Switch off optimizations */ @@ -3733,6 +4090,7 @@ typedef struct am_table_short AMTS; #define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto */ #define PERLDBf_NAMEEVAL 0x100 /* Informative names for evals */ #define PERLDBf_NAMEANON 0x200 /* Informative names for anon subs */ +#define PERLDBf_ASSERTION 0x400 /* Debug assertion subs enter/exit */ #define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB)) #define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE)) @@ -3744,7 +4102,7 @@ typedef struct am_table_short AMTS; #define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO)) #define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL)) #define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON)) - +#define PERLDB_ASSERTION (PL_perldb && (PL_perldb & PERLDBf_ASSERTION)) #ifdef USE_LOCALE_NUMERIC @@ -3758,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; \ @@ -3840,21 +4198,13 @@ 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 -#if !defined(PERLIO_IS_STDIO) -/* - * Remap printf - */ -#undef printf -#ifdef __GNUC__ -#define printf(fmt,args...) PerlIO_stdoutf(fmt,##args) -#else -#define printf PerlIO_stdoutf -#endif -#endif /* if these never got defined, they need defaults */ #ifndef PERL_SET_CONTEXT @@ -3893,11 +4243,9 @@ typedef struct am_table_short AMTS; */ #ifndef PERL_MICRO -# ifndef PERL_OLD_SIGNALS -# ifndef PERL_ASYNC_CHECK -# define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals() -# endif -# endif +# ifndef PERL_ASYNC_CHECK +# define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals() +# endif #endif #ifndef PERL_ASYNC_CHECK @@ -4048,6 +4396,10 @@ typedef struct am_table_short AMTS; # include #endif +#ifdef __Lynx__ +# include +#endif + #ifdef I_SYS_FILE # include #endif @@ -4075,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, @@ -4132,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 @@ -4156,6 +4521,7 @@ int flock(int fd, int op); /* 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? */ @@ -4191,6 +4557,92 @@ extern void moncontrol(int); #define UNICODE_PARA_SEPA_1 0x80 #define UNICODE_PARA_SEPA_2 0xA9 +#ifndef PIPESOCK_MODE +# 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_IN_FLAG 0x0008 +#define PERL_UNICODE_OUT_FLAG 0x0010 +#define PERL_UNICODE_ARGV_FLAG 0x0020 +#define PERL_UNICODE_LOCALE_FLAG 0x0040 +#define PERL_UNICODE_WIDESYSCALLS_FLAG 0x0080 /* for Sarathy */ + +#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_UNICODE_ALL_FLAGS 0x00ff + +#define PERL_UNICODE_STDIN 'I' +#define PERL_UNICODE_STDOUT 'O' +#define PERL_UNICODE_STDERR 'E' +#define PERL_UNICODE_STD 'S' +#define PERL_UNICODE_IN 'i' +#define PERL_UNICODE_OUT 'o' +#define PERL_UNICODE_INOUT 'D' +#define PERL_UNICODE_ARGV 'A' +#define PERL_UNICODE_LOCALE 'L' +#define PERL_UNICODE_WIDESYSCALLS 'W' + +#define PERL_SIGNALS_UNSAFE_FLAG 0x0001 + +/* From sigaction(2) (FreeBSD man page): + * | Signal routines normally execute with the signal that + * | caused their invocation blocked, but other signals may + * | yet occur. + * Emulation of this behavior (from within Perl) is enabled + * by defining PERL_BLOCK_SIGNALS. + */ +#define PERL_BLOCK_SIGNALS + +#if defined(HAS_SIGPROCMASK) && defined(PERL_BLOCK_SIGNALS) +# define PERL_BLOCKSIG_ADD(set,sig) \ + sigset_t set; sigemptyset(&(set)); sigaddset(&(set), sig) +# define PERL_BLOCKSIG_BLOCK(set) \ + sigprocmask(SIG_BLOCK, &(set), NULL) +# define PERL_BLOCKSIG_UNBLOCK(set) \ + sigprocmask(SIG_UNBLOCK, &(set), NULL) +#endif /* HAS_SIGPROCMASK && PERL_BLOCK_SIGNALS */ + +/* How about the old style of sigblock()? */ + +#ifndef PERL_BLOCKSIG_ADD +# define PERL_BLOCKSIG_ADD(set, sig) NOOP +#endif +#ifndef PERL_BLOCKSIG_BLOCK +# define PERL_BLOCKSIG_BLOCK(set) NOOP +#endif +#ifndef PERL_BLOCKSIG_UNBLOCK +# 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" @@ -4218,8 +4670,8 @@ extern void moncontrol(int); NVff NVgf - HAS_USLEEP HAS_UALARM + HAS_USLEEP HAS_SETITIMER HAS_GETITIMER