X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=d562a31a49ddcb62256735d0a7810b09d63dea58;hb=88bf70ddad663558df6e83dce8f369f639fc7dd6;hp=16c119ee682c7cfe7d277d8323aa1724d938de9a;hpb=ff68c7194e176ca1907544a3a65684b76834d0fe;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 16c119e..d562a31 100644 --- a/perl.h +++ b/perl.h @@ -1,6 +1,6 @@ /* perl.h * - * Copyright (c) 1987-1994, Larry Wall + * Copyright (c) 1987-1997, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -20,12 +20,39 @@ #undef NO_EMBED #define NO_EMBED #undef MULTIPLICITY -#undef HIDEMYMALLOC -#undef EMBEDMYMALLOC #undef USE_STDIO #define USE_STDIO #endif /* PERL_FOR_X2P */ +#define VOIDUSED 1 +#include "config.h" + +#include "embed.h" + +#ifdef __cplusplus +# define START_EXTERN_C extern "C" { +# define END_EXTERN_C } +# define EXTERN_C extern "C" +#else +# define START_EXTERN_C +# define END_EXTERN_C +# define EXTERN_C +#endif + +#if defined(USE_THREADS) /* && !defined(PERL_CORE) && !defined(PERLDLL) */ +#ifndef CRIPPLED_CC +#define CRIPPLED_CC +#endif +#endif + +#ifdef OP_IN_REGISTER +# ifdef __GNUC__ +# define stringify_immed(s) #s +# define stringify(s) stringify_immed(s) +register struct op *op asm(stringify(OP_IN_REGISTER)); +# endif +#endif + /* * STMT_START { statements; } STMT_END; * can be used as a single statement, as in @@ -34,7 +61,7 @@ * Trying to select a version that gives no warnings... */ #if !(defined(STMT_START) && defined(STMT_END)) -# if defined(__GNUC__) && !defined(__STRICT_ANSI__) +# if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(__cplusplus) # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ # define STMT_END ) # else @@ -49,10 +76,9 @@ # endif #endif -#include "embed.h" +#define NOOP (void)0 -#define VOIDUSED 1 -#include "config.h" +#define WITH_THR(s) do { dTHR; s; } while (0) /* * SOFT_CAST can be used for args to prototyped functions to retain some @@ -82,7 +108,7 @@ */ /* define this once if either system, instead of cluttering up the src */ -#if defined(MSDOS) || defined(atarist) +#if defined(MSDOS) || defined(atarist) || defined(WIN32) #define DOSISH 1 #endif @@ -90,6 +116,10 @@ # define STANDARD_C 1 #endif +#if defined(__cplusplus) || defined(WIN32) +# define DONT_DECLARE_STD 1 +#endif + #if defined(HASVOLATILE) || defined(STANDARD_C) # ifdef __cplusplus # define VOL // to temporarily suppress warnings @@ -190,14 +220,28 @@ #include #endif /* USE_NEXT_CTYPE */ -#ifdef I_LOCALE -#include -#endif - #ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ #undef METHOD #endif +#ifdef I_LOCALE +# include +#endif + +#if !defined(NO_LOCALE) && defined(HAS_SETLOCALE) +# define USE_LOCALE +# if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \ + && defined(HAS_STRXFRM) +# define USE_LOCALE_COLLATE +# endif +# if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE) +# define USE_LOCALE_CTYPE +# endif +# if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC) +# define USE_LOCALE_NUMERIC +# endif +#endif /* !NO_LOCALE && HAS_SETLOCALE */ + #include #ifdef I_SYS_PARAM @@ -246,9 +290,9 @@ #if defined(STANDARD_C) && defined(I_STDDEF) # include -# define OFFSETOF(s,m) offsetof(s,m) +# define STRUCT_OFFSET(s,m) offsetof(s,m) #else -# define OFFSETOF(s,m) (Size_t)(&(((s *)0)->m)) +# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) #endif #if defined(I_STRING) || defined(__cplusplus) @@ -262,10 +306,6 @@ #define strrchr rindex #endif -#if defined(mips) && defined(ultrix) && !defined(__STDC__) -# undef HAS_MEMCMP -#endif - #ifdef I_MEMORY # include #endif @@ -292,47 +332,71 @@ extern char *memset _((char*, int, int)); # endif # endif -# define memzero(d,l) memset(d,0,l) #else -# ifndef memzero -# ifdef HAS_BZERO -# define memzero(d,l) bzero(d,l) +# define memset(d,c,l) my_memset(d,c,l) +#endif /* HAS_MEMSET */ + +#if !defined(HAS_MEMMOVE) && !defined(memmove) +# if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY) +# define memmove(d,s,l) bcopy(s,d,l) +# else +# if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY) +# define memmove(d,s,l) memcpy(d,s,l) # else -# define memzero(d,l) my_bzero(d,l) +# define memmove(d,s,l) my_bcopy(s,d,l) # endif # endif -#endif /* HAS_MEMSET */ +#endif + +#if defined(mips) && defined(ultrix) && !defined(__STDC__) +# undef HAS_MEMCMP +#endif -#ifdef HAS_MEMCMP +#if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP) # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) # ifndef memcmp extern int memcmp _((char*, char*, int)); # endif # endif +# ifdef BUGGY_MSC + # pragma function(memcmp) +# endif #else # ifndef memcmp # define memcmp my_memcmp # endif -#endif /* HAS_MEMCMP */ +#endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */ -#if !defined(HAS_MEMMOVE) && !defined(memmove) -# if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY) -# define memmove(d,s,l) bcopy(s,d,l) +#ifndef memzero +# ifdef HAS_MEMSET +# define memzero(d,l) memset(d,0,l) # else -# if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY) -# define memmove(d,s,l) memcpy(d,s,l) +# ifdef HAS_BZERO +# define memzero(d,l) bzero(d,l) # else -# define memmove(d,s,l) my_bcopy(s,d,l) +# define memzero(d,l) my_bzero(d,l) # endif # endif #endif +#ifndef HAS_BCMP +# ifndef bcmp +# define bcmp(s1,s2,l) memcmp(s1,s2,l) +# endif +#endif /* !HAS_BCMP */ + #ifdef I_NETINET_IN # include #endif +#if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO) +/* defines SF_APPEND and might define SF_APPEND + * (the neo-BSD seem to do this). */ +# undef SF_APPEND +#endif + #ifdef I_SYS_STAT -#include +# include #endif /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives @@ -387,16 +451,25 @@ # include # endif #endif -#ifndef VMS -# define FIXSTATUS(sts) (U_L((sts) & 0xffff)) -# define SHIFTSTATUS(sts) ((sts) >> 8) -# define SETERRNO(errcode,vmserrcode) errno = (errcode) + +#ifdef VMS +# define SETERRNO(errcode,vmserrcode) \ + STMT_START { \ + set_errno(errcode); \ + set_vaxc_errno(vmserrcode); \ + } STMT_END #else -# define FIXSTATUS(sts) (U_L(sts)) -# define SHIFTSTATUS(sts) (sts) -# define SETERRNO(errcode,vmserrcode) STMT_START {set_errno(errcode); set_vaxc_errno(vmserrcode);} STMT_END +# define SETERRNO(errcode,vmserrcode) errno = (errcode) #endif +#ifdef USE_THREADS +# define ERRSV (thr->errsv) +# define ERRHV (thr->errhv) +#else +# define ERRSV GvSV(errgv) +# define ERRHV GvHV(errgv) +#endif /* USE_THREADS */ + #ifndef errno extern int errno; /* ANSI allows errno to be an lvalue expr */ #endif @@ -405,7 +478,9 @@ # ifdef VMS char *strerror _((int,...)); # else +#ifndef DONT_DECLARE_STD char *strerror _((int)); +#endif # endif # ifndef Strerror # define Strerror strerror @@ -579,10 +654,6 @@ # define SLOPPYDIVIDE #endif -#if defined(cray) || defined(convex) || BYTEORDER > 0xffff -# define HAS_QUAD -#endif - #ifdef UV #undef UV #endif @@ -600,16 +671,20 @@ --Andy Dougherty August 1996 */ -#ifdef HAS_QUAD -# ifdef cray -# define Quad_t int +#ifdef cray +# define Quad_t int +#else +# ifdef convex +# define Quad_t long long # else -# if defined(convex) -# define Quad_t long long -# else +# if BYTEORDER > 0xFFFF # define Quad_t long # endif # endif +#endif + +#ifdef Quad_t +# define HAS_QUAD typedef Quad_t IV; typedef unsigned Quad_t UV; # define IV_MAX PERL_QUAD_MAX @@ -806,6 +881,11 @@ #endif +/* Digital UNIX defines a typedef CONTEXT when pthreads is in use */ +#if defined(__osf__) +# define CONTEXT PERL_CONTEXT +#endif + typedef MEM_SIZE STRLEN; typedef struct op OP; @@ -823,7 +903,9 @@ typedef struct loop LOOP; typedef struct Outrec Outrec; typedef struct interpreter PerlInterpreter; -typedef struct ff FF; +#ifndef __BORLANDC__ +typedef struct ff FF; /* XXX not defined anywhere, should go? */ +#endif typedef struct sv SV; typedef struct av AV; typedef struct hv HV; @@ -876,8 +958,81 @@ typedef I32 (*filter_t) _((int, SV *, int)); # include "unixish.h" # endif # endif -#endif +#endif + +/* + * USE_THREADS 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 + */ + +#ifdef USE_THREADS +# ifdef FAKE_THREADS +# include "fakethr.h" +# else +# ifdef WIN32 +# include +# else +# include +typedef pthread_mutex_t perl_mutex; +typedef pthread_cond_t perl_cond; +typedef pthread_key_t perl_key; +# endif /* WIN32 */ +# endif /* FAKE_THREADS */ +#endif /* USE_THREADS */ + + +#ifdef VMS +# define STATUS_NATIVE statusvalue_vms +# define STATUS_NATIVE_EXPORT \ + ((I32)statusvalue_vms == -1 ? 44 : statusvalue_vms) +# define STATUS_NATIVE_SET(n) \ + STMT_START { \ + statusvalue_vms = (n); \ + if ((I32)statusvalue_vms == -1) \ + statusvalue = -1; \ + else if (statusvalue_vms & STS$M_SUCCESS) \ + statusvalue = 0; \ + else if ((statusvalue_vms & STS$M_SEVERITY) == 0) \ + statusvalue = 1 << 8; \ + else \ + statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8; \ + } STMT_END +# define STATUS_POSIX statusvalue +# ifdef VMSISH_STATUS +# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX) +# else +# define STATUS_CURRENT STATUS_POSIX +# endif +# define STATUS_POSIX_SET(n) \ + STMT_START { \ + statusvalue = (n); \ + if (statusvalue != -1) { \ + statusvalue &= 0xFFFF; \ + statusvalue_vms = statusvalue ? 44 : 1; \ + } \ + else statusvalue_vms = -1; \ + } STMT_END +# define STATUS_ALL_SUCCESS (statusvalue = 0, statusvalue_vms = 1) +# define STATUS_ALL_FAILURE (statusvalue = 1, statusvalue_vms = 44) +#else +# define STATUS_NATIVE STATUS_POSIX +# define STATUS_NATIVE_EXPORT STATUS_POSIX +# define STATUS_NATIVE_SET STATUS_POSIX_SET +# define STATUS_POSIX statusvalue +# define STATUS_POSIX_SET(n) \ + STMT_START { \ + statusvalue = (n); \ + if (statusvalue != -1) \ + statusvalue &= 0xFFFF; \ + } STMT_END +# define STATUS_CURRENT STATUS_POSIX +# define STATUS_ALL_SUCCESS (statusvalue = 0) +# define STATUS_ALL_FAILURE (statusvalue = 1) +#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 compmiler. Sigh. @@ -906,6 +1061,17 @@ union any { void (*any_dptr) _((void*)); }; +#ifdef USE_THREADS +#define ARGSproto struct thread *thr +#else +#define ARGSproto void +#endif /* USE_THREADS */ + +/* Work around some cygwin32 problems with importing global symbols */ +#if defined(CYGWIN32) && defined(DLLIMPORT) +# include "cw32imp.h" +#endif + #include "regexp.h" #include "sv.h" #include "util.h" @@ -988,13 +1154,7 @@ EXT char Error[1]; #define U_I(what) ((unsigned int)(what)) #define U_L(what) ((U32)(what)) #else -# ifdef __cplusplus - extern "C" { -# endif -U32 cast_ulong _((double)); -# ifdef __cplusplus - } -# endif +EXTERN_C U32 cast_ulong _((double)); #define U_S(what) ((U16)cast_ulong((double)(what))) #define U_I(what) ((unsigned int)cast_ulong((double)(what))) #define U_L(what) (cast_ulong((double)(what))) @@ -1005,15 +1165,11 @@ U32 cast_ulong _((double)); #define I_V(what) ((IV)(what)) #define U_V(what) ((UV)(what)) #else -# ifdef __cplusplus - extern "C" { -# endif +START_EXTERN_C I32 cast_i32 _((double)); IV cast_iv _((double)); UV cast_uv _((double)); -# ifdef __cplusplus - } -# endif +END_EXTERN_C #define I_32(what) (cast_i32((double)(what))) #define I_V(what) (cast_iv((double)(what))) #define U_V(what) (cast_uv((double)(what))) @@ -1101,7 +1257,7 @@ struct ufuncs { }; /* Fix these up for __STDC__ */ -#ifndef __cplusplus +#ifndef DONT_DECLARE_STD char *mktemp _((char*)); double atof _((const char*)); #endif @@ -1118,20 +1274,19 @@ char *strcpy(), *strcat(); #ifdef I_MATH # include #else -# ifdef __cplusplus - extern "C" { -# endif +START_EXTERN_C double exp _((double)); double log _((double)); + double log10 _((double)); double sqrt _((double)); + double frexp _((double,int*)); + double ldexp _((double,int)); double modf _((double,double*)); double sin _((double)); double cos _((double)); double atan2 _((double,double)); double pow _((double,double)); -# ifdef __cplusplus - }; -# endif +END_EXTERN_C #endif #ifndef __cplusplus @@ -1140,8 +1295,12 @@ char *crypt (); /* Maybe more hosts will need the unprototyped version */ #else char *crypt _((const char*, const char*)); #endif +#ifndef DONT_DECLARE_STD +#ifndef getenv char *getenv _((const char*)); +#endif Off_t lseek _((int,Off_t,int)); +#endif char *getlogin _((void)); #endif @@ -1181,25 +1340,52 @@ typedef Sighandler_t Sigsave_t; # ifndef register # define register # endif -# ifdef MYMALLOC -# ifndef DEBUGGING_MSTATS -# define DEBUGGING_MSTATS -# endif -# endif # define PAD_SV(po) pad_sv(po) +# define RUNOPS_DEFAULT runops_debug #else # define PAD_SV(po) curpad[po] +# define RUNOPS_DEFAULT runops_standard +#endif + +/* + * These need prototyping here because isn't + * included until after runops is initialised. + */ + +int runops_standard _((void)); +#ifdef DEBUGGING +int runops_debug _((void)); #endif +#define PER_THREAD_MAGICALS "123456789&`'+/.,\\\";^-%=|~:\001\005!@" + /****************/ /* Truly global */ /****************/ /* global state */ EXT PerlInterpreter * curinterp; /* currently running interpreter */ +#ifdef USE_THREADS +EXT perl_key thr_key; /* For per-thread struct thread ptr */ +EXT perl_mutex sv_mutex; /* Mutex for allocating SVs in sv.c */ +EXT perl_mutex malloc_mutex; /* Mutex for malloc */ +EXT perl_mutex eval_mutex; /* Mutex for doeval */ +EXT perl_cond eval_cond; /* Condition variable for doeval */ +EXT struct thread * eval_owner; /* Owner thread for doeval */ +EXT int nthreads; /* Number of threads currently */ +EXT perl_mutex threads_mutex; /* Mutex for nthreads and thread list */ +EXT perl_cond nthreads_cond; /* Condition variable for nthreads */ +EXT char * per_thread_magicals INIT(PER_THREAD_MAGICALS); +#ifdef FAKE_THREADS +EXT struct thread * thr; /* Currently executing (fake) thread */ +#endif +#endif /* USE_THREADS */ + /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */ #if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__)) +#if !defined(DONT_DECLARE_STD) || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) extern char ** environ; /* environment variables supplied via exec */ +#endif #else # if defined(NeXT) && defined(__DYNAMIC__) @@ -1221,10 +1407,12 @@ EXT U32 evalseq; /* eval sequence number */ EXT U32 sub_generation; /* inc to force methods to be looked up again */ EXT char ** origenviron; EXT U32 origalen; +EXT HV * pidstatus; /* pid-to-status mappings for waitpid */ EXT U32 * profiledata; EXT int maxo INIT(MAXO);/* Number of ops */ EXT char * osname; /* operating system */ EXT char * sh_path INIT(SH_PATH); /* full path of shell */ +EXT Sighandler_t sighandlerp; EXT XPV* xiv_arenaroot; /* list of allocated xiv areas */ EXT IV ** xiv_root; /* free xiv list--shared by interpreters */ @@ -1242,8 +1430,12 @@ EXT SV ** stack_max; /* stack->array_ary + stack->array_max */ /* likewise for these */ -EXT OP * op; /* current op--oughta be in a global register */ - +#ifdef OP_IN_REGISTER +EXT OP * opsave; /* save current op register across longjmps */ +#else +EXT OP * op; /* current op--when not in a global register */ +#endif +EXT int (*runops) _((void)) INIT(RUNOPS_DEFAULT); EXT I32 * scopestack; /* blocks we've entered */ EXT I32 scopestack_ix; EXT I32 scopestack_max; @@ -1264,9 +1456,7 @@ EXT SV ** curpad; /* temp space */ EXT SV * Sv; -EXT HE He; EXT XPV * Xpv; -EXT char buf[2048]; /* should be longer than PATH_MAX */ EXT char tokenbuf[256]; EXT struct stat statbuf; #ifdef HAS_TIMES @@ -1280,43 +1470,43 @@ EXT short * ds; EXT char * dc; /* handy constants */ -EXT char * Yes INIT("1"); -EXT char * No INIT(""); -EXT char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx"); -EXT char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"); -EXT char * vert INIT("|"); +EXTCONST char * Yes INIT("1"); +EXTCONST char * No INIT(""); +EXTCONST char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx"); +EXTCONST char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"); +EXTCONST char * vert INIT("|"); -EXT char warn_uninit[] +EXTCONST char warn_uninit[] INIT("Use of uninitialized value"); -EXT char warn_nosemi[] +EXTCONST char warn_nosemi[] INIT("Semicolon seems to be missing"); -EXT char warn_reserved[] +EXTCONST char warn_reserved[] INIT("Unquoted string \"%s\" may clash with future reserved word"); -EXT char warn_nl[] +EXTCONST char warn_nl[] INIT("Unsuccessful %s on filename containing newline"); -EXT char no_wrongref[] +EXTCONST char no_wrongref[] INIT("Can't use %s ref as %s ref"); -EXT char no_symref[] +EXTCONST char no_symref[] INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); -EXT char no_usym[] +EXTCONST char no_usym[] INIT("Can't use an undefined value as %s reference"); -EXT char no_aelem[] +EXTCONST char no_aelem[] INIT("Modification of non-creatable array value attempted, subscript %d"); -EXT char no_helem[] +EXTCONST char no_helem[] INIT("Modification of non-creatable hash value attempted, subscript \"%s\""); -EXT char no_modify[] +EXTCONST char no_modify[] INIT("Modification of a read-only value attempted"); -EXT char no_mem[] +EXTCONST char no_mem[] INIT("Out of memory!\n"); -EXT char no_security[] +EXTCONST char no_security[] INIT("Insecure dependency in %s%s"); -EXT char no_sock_func[] +EXTCONST char no_sock_func[] INIT("Unsupported socket function \"%s\" called"); -EXT char no_dir_func[] +EXTCONST char no_dir_func[] INIT("Unsupported directory function \"%s\" called"); -EXT char no_func[] +EXTCONST char no_func[] INIT("The %s function is unimplemented"); -EXT char no_myglob[] +EXTCONST char no_myglob[] INIT("\"my\" variable %s can't be in a package"); EXT SV sv_undef; @@ -1342,7 +1532,7 @@ EXT SV * psig_name[]; /* fast case folding tables */ #ifdef DOINIT -EXT const unsigned char fold[] = { +EXTCONST unsigned char fold[] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, @@ -1377,7 +1567,7 @@ EXT const unsigned char fold[] = { 248, 249, 250, 251, 252, 253, 254, 255 }; #else -EXT unsigned char fold[]; +EXTCONST unsigned char fold[]; #endif #ifdef DOINIT @@ -1420,7 +1610,7 @@ EXT unsigned char fold_locale[]; #endif #ifdef DOINIT -EXT unsigned char freq[] = { /* letter frequencies for mixed English/C */ +EXTCONST unsigned char freq[] = { /* letter frequencies for mixed English/C */ 1, 2, 84, 151, 154, 155, 156, 157, 165, 246, 250, 3, 158, 7, 18, 29, 40, 51, 62, 73, 85, 96, 107, 118, @@ -1455,12 +1645,12 @@ EXT unsigned char freq[] = { /* letter frequencies for mixed English/C */ 138, 139, 141, 142, 143, 144, 145, 146 }; #else -EXT unsigned char freq[]; +EXTCONST unsigned char freq[]; #endif #ifdef DEBUGGING #ifdef DOINIT -EXT char* block_type[] = { +EXTCONST char* block_type[] = { "NULL", "SUB", "EVAL", @@ -1469,7 +1659,7 @@ EXT char* block_type[] = { "BLOCK", }; #else -EXT char* block_type[]; +EXTCONST char* block_type[]; #endif #endif @@ -1480,6 +1670,8 @@ EXT char* block_type[]; #include "perly.h" +#define LEX_NOTPARSING 11 /* borrowed from toke.c */ + typedef enum { XOPERATOR, XTERM, @@ -1547,6 +1739,7 @@ EXT char * last_uni; /* position of last named-unary operator */ EXT char * last_lop; /* position of last list operator */ EXT OPCODE last_lop_op; /* last list operator */ EXT bool in_my; /* we're compiling a "my" declaration */ +EXT HV * in_my_stash; /* declared class of this "my" declaration */ #ifdef FCRYPT EXT I32 cryptseen; /* has fast crypt() been initialized? */ #endif @@ -1643,7 +1836,7 @@ IEXT char * Ie_tmpname; IEXT PerlIO * Ie_fp; IEXT U32 Iperldb; /* This value may be raised by extensions for testing purposes */ -IEXT int Iperl_destruct_level; /* 0=none, 1=full, 2=full with checks */ +IEXT int Iperl_destruct_level IINIT(0); /* 0=none, 1=full, 2=full with checks */ /* magical thingies */ IEXT Time_t Ibasetime; /* $^T */ @@ -1656,8 +1849,11 @@ IEXT char * Iors; /* $\ */ IEXT STRLEN Iorslen; IEXT char * Iofmt; /* $# */ IEXT I32 Imaxsysfd IINIT(MAXSYSFD); /* top fd to pass to subprocesses */ -IEXT int Imultiline; /* $*--do strings hold >1 line? */ -IEXT U32 Istatusvalue; /* $? */ +IEXT int Imultiline; /* $*--do strings hold >1 line? */ +IEXT I32 Istatusvalue; /* $? */ +#ifdef VMS +IEXT U32 Istatusvalue_vms; +#endif IEXT struct stat Istatcache; /* _ */ IEXT GV * Istatgv; @@ -1701,6 +1897,7 @@ IEXT HV * Idebstash; /* symbol table for perldb package */ IEXT SV * Icurstname; /* name of current package */ IEXT AV * Ibeginav; /* names of BEGIN subroutines */ IEXT AV * Iendav; /* names of END subroutines */ +IEXT AV * Iinitav; /* names of INIT subroutines */ IEXT HV * Istrtab; /* shared string table */ /* memory management */ @@ -1720,7 +1917,6 @@ IEXT int Iforkprocess; /* so do_open |- can return proc# */ /* subprocess state */ IEXT AV * Ifdpid; /* keep fd-to-pid mappings for my_popen */ -IEXT HV * Ipidstatus; /* keep pid-to-status mappings for waitpid */ /* internal state */ IEXT VOL int Iin_eval; /* trap "fatal" errors? */ @@ -1752,15 +1948,13 @@ IEXT line_t Icopline IINIT(NOLINE); IEXT CONTEXT * Icxstack; IEXT I32 Icxstack_ix IINIT(-1); IEXT I32 Icxstack_max IINIT(128); -IEXT Sigjmp_buf Itop_env; +IEXT JMPENV Istart_env; /* empty startup sigjmp() environment */ +IEXT JMPENV * Itop_env; /* ptr. to current sigjmp() environment */ IEXT I32 Irunlevel; /* stack stuff */ IEXT AV * Icurstack; /* THE STACK */ IEXT AV * Imainstack; /* the stack when nothing funny is happening */ -IEXT SV ** Imystack_base; /* stack->array_ary */ -IEXT SV ** Imystack_sp; /* stack pointer now */ -IEXT SV ** Imystack_max; /* stack->array_ary + stack->array_max */ /* format accumulators */ IEXT SV * Iformtarget; @@ -1788,6 +1982,12 @@ IEXT bool Ipreambled; IEXT AV * Ipreambleav; IEXT int Ilaststatval IINIT(-1); IEXT I32 Ilaststype IINIT(OP_STAT); +IEXT SV * Imess_sv; + +#ifdef USE_THREADS +/* threads stuff */ +IEXT SV * Ithrsv; /* holds struct thread for main thread */ +#endif /* USE_THREADS */ #undef IEXT #undef IINIT @@ -1800,12 +2000,10 @@ struct interpreter { }; #endif +#include "thread.h" #include "pp.h" -#ifdef __cplusplus -extern "C" { -#endif - +START_EXTERN_C #include "proto.h" #ifdef EMBED @@ -1816,9 +2014,7 @@ extern "C" { #define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr) #endif -#ifdef __cplusplus -}; -#endif +END_EXTERN_C /* The following must follow proto.h */ @@ -1828,7 +2024,9 @@ EXT MGVTBL vtbl_sv = {magic_get, magic_set, magic_len, 0, 0}; -EXT MGVTBL vtbl_env = {0, 0, 0, 0, 0}; +EXT MGVTBL vtbl_env = {0, magic_set_all_env, + 0, magic_clear_all_env, + 0}; EXT MGVTBL vtbl_envelem = {0, magic_setenv, 0, magic_clearenv, 0}; @@ -1846,7 +2044,8 @@ EXT MGVTBL vtbl_packelem = {magic_getpack, EXT MGVTBL vtbl_dbline = {0, magic_setdbline, 0, 0, 0}; EXT MGVTBL vtbl_isa = {0, magic_setisa, - 0, 0, 0}; + 0, magic_setisa, + 0}; EXT MGVTBL vtbl_isaelem = {0, magic_setisa, 0, 0, 0}; EXT MGVTBL vtbl_arylen = {magic_getarylen, @@ -1875,8 +2074,13 @@ EXT MGVTBL vtbl_fm = {0, magic_setfm, EXT MGVTBL vtbl_uvar = {magic_getuvar, magic_setuvar, 0, 0, 0}; +#ifdef USE_THREADS +EXT MGVTBL vtbl_mutex = {0, 0, 0, 0, magic_mutexfree}; +#endif /* USE_THREADS */ +EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem, + 0, 0, magic_freedefelem}; -#ifdef LC_COLLATE +#ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm = {0, magic_setcollxfrm, 0, 0, 0}; @@ -1913,7 +2117,13 @@ EXT MGVTBL vtbl_bm; EXT MGVTBL vtbl_fm; EXT MGVTBL vtbl_uvar; -#ifdef HAS_STRXFRM +#ifdef USE_THREADS +EXT MGVTBL vtbl_mutex; +#endif /* USE_THREADS */ + +EXT MGVTBL vtbl_defelem; + +#ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm; #endif @@ -1925,57 +2135,70 @@ EXT MGVTBL vtbl_amagicelem; #endif /* !DOINIT */ #ifdef OVERLOAD + EXT long amagic_generation; -#define NofAMmeth 29 +#define NofAMmeth 58 #ifdef DOINIT -EXT char * AMG_names[NofAMmeth][2] = { - {"fallback","abs"}, - {"bool", "nomethod"}, - {"\"\"", "0+"}, - {"+","+="}, - {"-","-="}, - {"*", "*="}, - {"/", "/="}, - {"%", "%="}, - {"**", "**="}, - {"<<", "<<="}, - {">>", ">>="}, - {"&", "&="}, - {"|", "|="}, - {"^", "^="}, - {"<", "<="}, - {">", ">="}, - {"==", "!="}, - {"<=>", "cmp"}, - {"lt", "le"}, - {"gt", "ge"}, - {"eq", "ne"}, - {"!", "~"}, - {"++", "--"}, - {"atan2", "cos"}, - {"sin", "exp"}, - {"log", "sqrt"}, - {"x","x="}, - {".",".="}, - {"=","neg"} +EXTCONST char * AMG_names[NofAMmeth] = { + "fallback", "abs", /* "fallback" should be the first. */ + "bool", "nomethod", + "\"\"", "0+", + "+", "+=", + "-", "-=", + "*", "*=", + "/", "/=", + "%", "%=", + "**", "**=", + "<<", "<<=", + ">>", ">>=", + "&", "&=", + "|", "|=", + "^", "^=", + "<", "<=", + ">", ">=", + "==", "!=", + "<=>", "cmp", + "lt", "le", + "gt", "ge", + "eq", "ne", + "!", "~", + "++", "--", + "atan2", "cos", + "sin", "exp", + "log", "sqrt", + "x", "x=", + ".", ".=", + "=", "neg" }; #else -EXT char * AMG_names[NofAMmeth][2]; +EXTCONST char * AMG_names[NofAMmeth]; #endif /* def INITAMAGIC */ -struct am_table { +struct am_table { long was_ok_sub; long was_ok_am; - CV* table[NofAMmeth*2]; + U32 flags; + CV* table[NofAMmeth]; long fallback; }; +struct am_table_short { + long was_ok_sub; + long was_ok_am; + U32 flags; +}; typedef struct am_table AMT; +typedef struct am_table_short AMTS; #define AMGfallNEVER 1 #define AMGfallNO 2 #define AMGfallYES 3 +#define AMTf_AMAGIC 1 +#define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC) +#define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC) +#define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC) + enum { fallback_amg, abs_amg, bool__amg, nomethod_amg, @@ -2007,33 +2230,88 @@ enum { concat_amg, concat_ass_amg, copy_amg, neg_amg }; + +/* + * some compilers like to redefine cos et alia as faster + * (and less accurate?) versions called F_cos et cetera (Quidquid + * latine dictum sit, altum viditur.) This trick collides with + * the Perl overloading (amg). The following #defines fool both. + */ + +#ifdef _FASTMATH +# ifdef atan2 +# define F_atan2_amg atan2_amg +# endif +# ifdef cos +# define F_cos_amg cos_amg +# endif +# ifdef exp +# define F_exp_amg exp_amg +# endif +# ifdef log +# define F_log_amg log_amg +# endif +# ifdef pow +# define F_pow_amg pow_amg +# endif +# ifdef sin +# define F_sin_amg sin_amg +# endif +# ifdef sqrt +# define F_sqrt_amg sqrt_amg +# endif +#endif /* _FASTMATH */ + #endif /* OVERLOAD */ - -#ifdef LC_COLLATE + +#define PERLDB_ALL 0xff +#define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */ +#define PERLDBf_LINE 0x02 /* Keep line #. */ +#define PERLDBf_NOOPT 0x04 /* Switch off optimizations. */ +#define PERLDBf_INTER 0x08 /* Preserve more data for + later inspections. */ +#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines. */ +#define PERLDBf_SINGLE 0x20 /* Start with single-step on. */ + +#define PERLDB_SUB (perldb && (perldb & PERLDBf_SUB)) +#define PERLDB_LINE (perldb && (perldb & PERLDBf_LINE)) +#define PERLDB_NOOPT (perldb && (perldb & PERLDBf_NOOPT)) +#define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER)) +#define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE)) +#define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE)) + +#ifdef USE_LOCALE_COLLATE EXT U32 collation_ix; /* Collation generation index */ EXT char * collation_name; /* Name of current collation */ EXT bool collation_standard INIT(TRUE); /* Assume simple collation */ EXT Size_t collxfrm_base; /* Basic overhead in *xfrm() */ EXT Size_t collxfrm_mult INIT(2); /* Expansion factor in *xfrm() */ -#endif /* LC_COLLATE */ +#endif /* USE_LOCALE_COLLATE */ -#ifdef LC_NUMERIC +#ifdef USE_LOCALE_NUMERIC EXT char * numeric_name; /* Name of current numeric locale */ EXT bool numeric_standard INIT(TRUE); /* Assume simple numerics */ EXT bool numeric_local INIT(TRUE); /* Assume local numerics */ -#define NUMERIC_STANDARD() \ - STMT_START { if (! numeric_standard) perl_numeric_standard(); } STMT_END -#define NUMERIC_LOCAL() \ - STMT_START { if (! numeric_local) perl_numeric_local(); } STMT_END +#define SET_NUMERIC_STANDARD() \ + STMT_START { \ + if (! numeric_standard) \ + perl_set_numeric_standard(); \ + } STMT_END + +#define SET_NUMERIC_LOCAL() \ + STMT_START { \ + if (! numeric_local) \ + perl_set_numeric_local(); \ + } STMT_END -#else /* !LC_NUMERIC */ +#else /* !USE_LOCALE_NUMERIC */ -#define NUMERIC_STANDARD() /**/ -#define NUMERIC_LOCAL() /**/ +#define SET_NUMERIC_STANDARD() /**/ +#define SET_NUMERIC_LOCAL() /**/ -#endif /* !LC_NUMERIC */ +#endif /* !USE_LOCALE_NUMERIC */ #if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE) /* @@ -2043,5 +2321,18 @@ EXT bool numeric_local INIT(TRUE); /* Assume local numerics */ #define printf PerlIO_stdoutf #endif +/* + * nice_chunk and nice_chunk size need to be set + * and queried under the protection of sv_mutex + */ +#define offer_nice_chunk(chunk, chunk_size) do { \ + MUTEX_LOCK(&sv_mutex); \ + if (!nice_chunk) { \ + nice_chunk = (char*)(chunk); \ + nice_chunk_size = (chunk_size); \ + } \ + MUTEX_UNLOCK(&sv_mutex); \ + } while (0) + #endif /* Include guard */