X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=acadabe4e37c9790a8bd433508a4e1292e219341;hb=7996736c5ecb6da6273386229ce113837049152c;hp=28e3f589ab494a669943fa77a3b8bb375c6bbc60;hpb=205f51d8e6c484299677945023b990c3cad50d1e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 28e3f58..acadabe 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, 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(DARWIN) # define USE_REENTRANT_API #endif /* <--- here ends the logic shared by perl.h and makedef.pl */ +/* + * DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned) + * (The -DDARWIN comes from the hints/darwin.sh.) + * __bsdi__ for BSD/OS + */ +#if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(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, @@ -228,12 +215,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(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) && !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 @@ -361,8 +348,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 @@ -495,28 +481,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 @@ -684,18 +684,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 @@ -730,19 +719,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 */ @@ -1272,12 +1279,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 @@ -1677,17 +1690,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; @@ -1929,12 +1935,18 @@ typedef struct clone_params CLONE_PARAMS; # define PERL_FPU_INIT fpsetmask(0); # else # if defined(SIGFPE) && defined(SIG_IGN) -# define PERL_FPU_INIT signal(SIGFPE, SIG_IGN); +# 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) @@ -1948,37 +1960,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 @@ -2013,7 +2022,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" @@ -2117,24 +2126,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 @@ -2159,6 +2171,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. @@ -2186,9 +2206,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 @@ -2199,17 +2224,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) @@ -2235,11 +2255,18 @@ 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 */ +#if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT) +# define USE_HASH_SEED_EXPLICIT +#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" @@ -2452,7 +2479,6 @@ 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 */ #define DEBUG_H_FLAG 0x00002000 /* 8192 */ #define DEBUG_X_FLAG 0x00004000 /* 16384 */ #define DEBUG_D_FLAG 0x00008000 /* 32768 */ @@ -2462,7 +2488,7 @@ 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 0x003FFFFF /* mask of all the standard flags */ +#define DEBUG_MASK 0x003FEFFF /* mask of all the standard flags */ #define DEBUG_DB_RECURSE_FLAG 0x40000000 #define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal @@ -2480,7 +2506,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) @@ -2490,6 +2515,7 @@ 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_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_) #ifdef DEBUGGING @@ -2508,9 +2534,9 @@ 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_ @@ -2545,16 +2571,12 @@ 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) @@ -2575,9 +2597,9 @@ 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) @@ -2600,9 +2622,9 @@ 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) @@ -2612,6 +2634,13 @@ Gid_t getegid (void); #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 @@ -2652,6 +2681,7 @@ Gid_t getegid (void); #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 */ @@ -2871,10 +2901,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 @@ -2911,13 +2939,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(DARWIN)) # if defined(NeXT) || defined(__NeXT) # include # define environ (*environ_pointer) EXT char *** environ_pointer; # else -# if defined(__APPLE__) && defined(PERL_CORE) +# if defined(DARWIN) && defined(PERL_CORE) # include /* for the env array */ # define environ (*_NSGetEnviron()) # endif @@ -2969,6 +2997,8 @@ 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"); EXTCONST char PL_uuemap[65] INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); @@ -3211,6 +3241,7 @@ typedef enum { 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 */ @@ -3240,28 +3271,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 @@ -3269,12 +3300,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 @@ -3356,9 +3392,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 @@ -3373,21 +3407,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 @@ -3395,6 +3415,25 @@ 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 */ +} tempsym_t; + #include "thread.h" #include "pp.h" @@ -3440,9 +3479,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 @@ -3532,15 +3569,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}; @@ -3562,6 +3595,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; @@ -3587,10 +3624,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; @@ -3604,6 +3637,7 @@ EXT MGVTBL PL_vtbl_amagic; EXT MGVTBL PL_vtbl_amagicelem; EXT MGVTBL PL_vtbl_backref; +EXT MGVTBL PL_vtbl_utf8; #endif /* !DOINIT */ @@ -3759,8 +3793,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 */ @@ -3772,6 +3806,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)) @@ -3783,7 +3818,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 @@ -3883,17 +3918,6 @@ typedef struct am_table_short AMTS; # 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 @@ -3932,11 +3956,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 @@ -4114,7 +4136,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, @@ -4195,6 +4217,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? */ @@ -4230,6 +4253,84 @@ extern void moncontrol(int); #define UNICODE_PARA_SEPA_1 0x80 #define UNICODE_PARA_SEPA_2 0xA9 +#ifndef PIPESOCK_MODE +# define 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" @@ -4257,8 +4358,8 @@ extern void moncontrol(int); NVff NVgf - HAS_USLEEP HAS_UALARM + HAS_USLEEP HAS_SETITIMER HAS_GETITIMER