X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=d8a035e5009cecf70a57e4c2b6e2c069c57f3f4d;hb=41cd373618dfb8cfe39ec8169c4a1b162678c980;hp=7486c16d9c799a4542a286d7c9eadeac3a390d45;hpb=6ca796d8ae94908bbc34cd873f81a4bfacef7c12;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 7486c16..d8a035e 100644 --- a/perl.h +++ b/perl.h @@ -8,7 +8,8 @@ */ #ifndef H_PERL #define H_PERL 1 -#define OVERLOAD + +/*#define PERL_IMPLICIT_CONTEXT*/ #ifdef PERL_FOR_X2P /* @@ -108,9 +109,7 @@ class CPerlObj; #define PERL_OBJECT_THIS this #define _PERL_OBJECT_THIS ,this #define PERL_OBJECT_THIS_ this, -#define CALLRUNOPS (this->*PL_runops) -#define CALLREGCOMP (this->*PL_regcompp) -#define CALLREGEXEC (this->*PL_regexecp) +#define CALL_FPTR(fptr) (this->*fptr) #else /* !PERL_OBJECT */ @@ -124,17 +123,21 @@ class CPerlObj; #define PERL_OBJECT_THIS #define _PERL_OBJECT_THIS #define PERL_OBJECT_THIS_ -#define CALLRUNOPS (*PL_runops) -#define CALLREGCOMP (*PL_regcompp) -#define CALLREGEXEC (*PL_regexecp) +#define CALL_FPTR(fptr) (*fptr) #endif /* PERL_OBJECT */ +#define CALLRUNOPS CALL_FPTR(PL_runops) +#define CALLREGCOMP CALL_FPTR(PL_regcompp) +#define CALLREGEXEC CALL_FPTR(PL_regexecp) +#define CALLPROTECT CALL_FPTR(PL_protect) + #define VOIDUSED 1 #include "config.h" -#if !defined(PERL_FOR_X2P) -# include "embed.h" +/* XXXXXX testing threads via implicit pointer */ +#ifdef USE_THREADS +#define PERL_IMPLICIT_CONTEXT #endif #undef START_EXTERN_C @@ -182,7 +185,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #endif #define NOOP (void)0 - +#define dNOOP extern int Perl___notused #define WITH_THR(s) STMT_START { dTHR; s; } STMT_END /* @@ -219,7 +222,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); */ /* define this once if either system, instead of cluttering up the src */ -#if defined(MSDOS) || defined(atarist) || defined(WIN32) +#if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(CYGWIN32) #define DOSISH 1 #endif @@ -324,8 +327,6 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # endif #endif -#include "iperlsys.h" - #ifdef USE_NEXT_CTYPE #if NX_CURRENT_COMPILER_RELEASE >= 500 @@ -379,53 +380,40 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # include #endif +#if !defined(PERL_FOR_X2P) +# include "embed.h" +#endif + #define MEM_SIZE Size_t /* This comes after so we don't try to change the standard * library prototypes; we'll use our own in proto.h instead. */ #ifdef MYMALLOC - -# ifdef HIDEMYMALLOC -# define malloc Mymalloc -# define calloc Mycalloc -# define realloc Myrealloc -# define free Myfree -Malloc_t Mymalloc _((MEM_SIZE nbytes)); -Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size)); -Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes)); -Free_t Myfree _((Malloc_t where)); -# endif -# ifdef EMBEDMYMALLOC -# define malloc Perl_malloc -# define calloc Perl_calloc -# define realloc Perl_realloc -/* VMS' external symbols are case-insensitive, and there's already a */ -/* perl_free in perl.h */ -#ifdef VMS -# define free Perl_myfree -#else -# define free Perl_free -#endif -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)); -#ifdef VMS -Free_t Perl_myfree _((Malloc_t where)); -#else -Free_t Perl_free _((Malloc_t where)); -#endif -# endif - -# undef safemalloc -# undef safecalloc -# undef saferealloc -# undef safefree -# define safemalloc malloc -# define safecalloc calloc -# define saferealloc realloc -# define safefree free - +# ifdef PERL_POLLUTE_MALLOC +# define Perl_malloc malloc +# define Perl_calloc calloc +# define Perl_realloc realloc +# define Perl_mfree free +# else +# define EMBEDMYMALLOC /* for compatibility */ +# endif +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); + +# define safemalloc Perl_malloc +# define safecalloc Perl_calloc +# define saferealloc Perl_realloc +# define safefree Perl_mfree +#else /* MYMALLOC */ +# define safemalloc safesysmalloc +# define safecalloc safesyscalloc +# define saferealloc safesysrealloc +# define safefree safesysfree #endif /* MYMALLOC */ #if defined(STANDARD_C) && defined(I_STDDEF) @@ -453,7 +441,7 @@ Free_t Perl_free _((Malloc_t where)); #ifdef HAS_MEMCPY # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) # ifndef memcpy - extern char * memcpy _((char*, char*, int)); + extern char * memcpy (char*, char*, int); # endif # endif #else @@ -469,7 +457,7 @@ Free_t Perl_free _((Malloc_t where)); #ifdef HAS_MEMSET # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) # ifndef memset - extern char *memset _((char*, int, int)); + extern char *memset (char*, int, int); # endif # endif #else @@ -495,7 +483,7 @@ Free_t Perl_free _((Malloc_t where)); #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)); + extern int memcmp (char*, char*, int); # endif # endif # ifdef BUGGY_MSC @@ -519,6 +507,12 @@ Free_t Perl_free _((Malloc_t where)); # endif #endif +#ifndef memchr +# ifndef HAS_MEMCHR +# define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1) +# endif +#endif + #ifndef HAS_BCMP # ifndef bcmp # define bcmp(s1,s2,l) memcmp(s1,s2,l) @@ -622,10 +616,10 @@ Free_t Perl_free _((Malloc_t where)); #ifdef HAS_STRERROR # ifdef VMS - char *strerror _((int,...)); + char *strerror (int,...); # else #ifndef DONT_DECLARE_STD - char *strerror _((int)); + char *strerror (int); #endif # endif # ifndef Strerror @@ -668,7 +662,8 @@ Free_t Perl_free _((Malloc_t where)); /* Configure already sets Direntry_t */ #if defined(I_DIRENT) # include -# if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */ + /* NeXT needs dirent + sys/dir.h */ +# if defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__)) # include # endif #else @@ -1309,16 +1304,6 @@ typedef union any ANY; # endif #endif -#ifdef PERL_OBJECT -typedef I32 (*filter_t) _((CPerlObj*, int, SV *, int)); -#else -typedef I32 (*filter_t) _((int, SV *, int)); -#endif - -#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) -#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx]) -#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters)) - #if defined(__OPEN_VM) # include "vmesa/vmesaish.h" #endif @@ -1349,6 +1334,28 @@ typedef I32 (*filter_t) _((int, SV *, int)); # endif #endif +#ifndef MAXPATHLEN +# 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) +# else +# define MAXPATHLEN (_POSIX_PATH_MAX+1) +# endif +# else +# define MAXPATHLEN (PATH_MAX+1) +# endif +# else +# ifdef _POSIX_PATH_MAX +# define MAXPATHLEN (_POSIX_PATH_MAX+1) +# else +# define MAXPATHLEN 1024 /* Err on the large side. */ +# endif +# endif +#endif + #ifndef FUNC_NAME_TO_PTR #define FUNC_NAME_TO_PTR(name) name #endif @@ -1376,7 +1383,7 @@ typedef I32 (*filter_t) _((int, SV *, int)); # else # ifdef I_MACH_CTHREADS # include -# ifdef NeXT +# if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC) # define MUTEX_INIT_CALLS_MALLOC # endif typedef cthread_t perl_os_thread; @@ -1444,6 +1451,22 @@ typedef pthread_key_t perl_key; # define STATUS_ALL_FAILURE (PL_statusvalue = 1) #endif +/* This defines a way to flush all output buffers. This may be a + * performance issue, so we allow people to disable it. + * XXX the default needs a Configure test, as it may not work everywhere. + */ +#ifndef PERL_FLUSHALL_FOR_CHILD +# if defined(FFLUSH_NULL) || defined(USE_SFIO) +# define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL) +# else +# ifdef FFLUSH_ALL +# define PERL_FLUSHALL_FOR_CHILD my_fflush_all() +# else +# define PERL_FLUSHALL_FOR_CHILD (void)0 +# endif +# 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 compmiler. Sigh. @@ -1464,6 +1487,56 @@ typedef pthread_key_t perl_key; # endif #endif +#if defined(CYGWIN32) +/* USEMYBINMODE + * This symbol, if defined, indicates that the program should + * use the routine my_binmode(FILE *fp, char iotype) to insure + * that a file is in "binary" mode -- that is, that no translation + * of bytes occurs on read or write operations. + */ +# define USEMYBINMODE / **/ +# define my_binmode(fp, iotype) \ + (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : NULL) +#endif + +#ifdef PERL_IMPLICIT_CONTEXT +# ifdef USE_THREADS +struct perl_thread; +# define pTHX struct perl_thread *thr +# define aTHX thr +# define dTHXa(a) pTHX = (struct perl_thread *)a +# define dTHX dTHXa(SvPVX(PL_thrsv)) +# define dTHR dNOOP +# else +# define MULTIPLICITY +# define pTHX PerlInterpreter *my_perl +# define aTHX my_perl +# define dTHXa(a) pTHX = (PerlInterpreter *)a +# define dTHX dTHXa(PL_curinterp) +# endif +# define pTHX_ pTHX, +# define _pTHX ,pTHX +# define aTHX_ aTHX, +# define _aTHX ,aTHX +#endif + +#ifndef pTHX +# define pTHX void +# define pTHX_ +# define _pTHX +# define aTHX +# define aTHX_ +# define _aTHX +# define dTHXa(a) dNOOP +# define dTHX dNOOP +#endif + +#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END + +#ifndef STATIC +# define STATIC static +#endif + #ifdef UNION_ANY_DEFINITION UNION_ANY_DEFINITION; #else @@ -1472,21 +1545,31 @@ union any { I32 any_i32; IV any_iv; long any_long; - void (CPERLscope(*any_dptr)) _((void*)); + void (CPERLscope(*any_dptr)) (pTHX_ void*); }; #endif #ifdef USE_THREADS #define ARGSproto struct perl_thread *thr #else -#define ARGSproto void +#define ARGSproto #endif /* USE_THREADS */ -/* Work around some cygwin32 problems with importing global symbols */ -#if defined(CYGWIN32) && defined(DLLIMPORT) -# include "cw32imp.h" +#ifdef PERL_OBJECT +typedef I32 (*filter_t) (CPerlObj*, int, SV *, int); +#else +typedef I32 (*filter_t) (pTHX_ int, SV *, int); #endif +#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) +#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx]) +#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters)) + +#ifdef WIN32 +#include "win32.h" +#endif + +#include "iperlsys.h" #include "regexp.h" #include "sv.h" #include "util.h" @@ -1503,8 +1586,6 @@ union any { #include "mg.h" #include "scope.h" #include "warning.h" -#include "bytecode.h" -#include "byterun.h" #include "utf8.h" /* Current curly descriptor */ @@ -1526,11 +1607,14 @@ struct _sublex_info { I32 super_state; /* lexer state to save */ I32 sub_inwhat; /* "lex_inwhat" to use */ OP *sub_op; /* "lex_op" to use */ + char *super_bufptr; /* PL_bufptr that was */ + char *super_bufend; /* PL_bufend that was */ }; typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ -#ifdef PERL_OBJECT +/* Length of a variant. */ + typedef struct { I32 len_min; I32 len_delta; @@ -1550,7 +1634,6 @@ typedef struct { } scan_data_t; typedef I32 CHECKPOINT; -#endif /* PERL_OBJECT */ #if defined(iAPX286) || defined(M_I286) || defined(I80286) # define I286 @@ -1598,7 +1681,7 @@ typedef I32 CHECKPOINT; # define HAS_VTOHS # define HAS_HTOVL # define HAS_HTOVS -# if BYTEORDER == 0x4321 +# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 # define vtohl(x) ((((x)&0xFF)<<24) \ +(((x)>>24)&0xFF) \ +(((x)&0x0000FF00)<<8) \ @@ -1615,7 +1698,6 @@ typedef I32 CHECKPOINT; #define U_I(what) ((unsigned int)(what)) #define U_L(what) ((U32)(what)) #else -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))) @@ -1626,16 +1708,16 @@ EXTERN_C U32 cast_ulong _((double)); #define I_V(what) ((IV)(what)) #define U_V(what) ((UV)(what)) #else -START_EXTERN_C -I32 cast_i32 _((double)); -IV cast_iv _((double)); -UV cast_uv _((double)); -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))) #endif +/* Used with UV/IV arguments: */ + /* XXXX: need to speed it up */ +#define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv)) +#define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv)) + struct Outrec { I32 o_lines; char *o_str; @@ -1651,16 +1733,17 @@ struct Outrec { #endif #ifndef __cplusplus -Uid_t getuid _((void)); -Uid_t geteuid _((void)); -Gid_t getgid _((void)); -Gid_t getegid _((void)); +Uid_t getuid (void); +Uid_t geteuid (void); +Gid_t getgid (void); +Gid_t getegid (void); #endif -#ifdef DEBUGGING #ifndef Perl_debug_log #define Perl_debug_log PerlIO_stderr() #endif + +#ifdef DEBUGGING #undef YYDEBUG #define YYDEBUG 1 #define DEB(a) a @@ -1672,7 +1755,11 @@ Gid_t getegid _((void)); #define DEBUG_o(a) if (PL_debug & 16) a #define DEBUG_c(a) if (PL_debug & 32) a #define DEBUG_P(a) if (PL_debug & 64) a -#define DEBUG_m(a) if (PL_curinterp && PL_debug & 128) a +# if defined(PERL_OBJECT) +# define DEBUG_m(a) if (PL_debug & 128) a +# else +# define DEBUG_m(a) if (PL_curinterp && PL_debug & 128) a +# endif #define DEBUG_f(a) if (PL_debug & 256) a #define DEBUG_r(a) if (PL_debug & 512) a #define DEBUG_x(a) if (PL_debug & 1024) a @@ -1712,22 +1799,22 @@ Gid_t getegid _((void)); #ifndef assert /* might have been included somehow */ #define assert(what) DEB( { \ if (!(what)) { \ - croak("Assertion failed: file \"%s\", line %d", \ + Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d", \ __FILE__, __LINE__); \ - PerlProc_exit(1); \ + PerlProc_exit(1); \ }}) #endif struct ufuncs { - I32 (*uf_val)_((IV, SV*)); - I32 (*uf_set)_((IV, SV*)); + I32 (*uf_val)(IV, SV*); + I32 (*uf_set)(IV, SV*); IV uf_index; }; /* Fix these up for __STDC__ */ #ifndef DONT_DECLARE_STD -char *mktemp _((char*)); -double atof _((const char*)); +char *mktemp (char*); +double atof (const char*); #endif #ifndef STANDARD_C @@ -1748,42 +1835,42 @@ char *strcpy(), *strcat(); # include #else 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)); + 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); END_EXTERN_C #endif #ifndef __cplusplus -# ifdef __NeXT__ /* or whatever catches all NeXTs */ +# if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */ char *crypt (); /* Maybe more hosts will need the unprototyped version */ # else # if !defined(WIN32) || !defined(HAVE_DES_FCRYPT) -char *crypt _((const char*, const char*)); +char *crypt (const char*, const char*); # endif /* !WIN32 && !HAVE_CRYPT_SOURCE */ -# endif /* !__NeXT__ */ +# endif /* !NeXT && !__NeXT__ */ # ifndef DONT_DECLARE_STD # ifndef getenv -char *getenv _((const char*)); +char *getenv (const char*); # endif /* !getenv */ -Off_t lseek _((int,Off_t,int)); +Off_t lseek (int,Off_t,int); # endif /* !DONT_DECLARE_STD */ -char *getlogin _((void)); +char *getlogin (void); #endif /* !__cplusplus */ #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ #define UNLINK unlnk -I32 unlnk _((char*)); +I32 unlnk (char*); #else -#define UNLINK unlink +#define UNLINK PerlLIO_unlink #endif #ifndef HAS_SETREUID @@ -1799,7 +1886,7 @@ I32 unlnk _((char*)); # endif #endif -typedef Signal_t (*Sighandler_t) _((int)); +typedef Signal_t (*Sighandler_t) (int); #ifdef HAS_SIGACTION typedef struct sigaction Sigsave_t; @@ -1816,10 +1903,10 @@ typedef Sighandler_t Sigsave_t; # define register # endif # define PAD_SV(po) pad_sv(po) -# define RUNOPS_DEFAULT runops_debug +# define RUNOPS_DEFAULT Perl_runops_debug #else # define PAD_SV(po) PL_curpad[po] -# define RUNOPS_DEFAULT runops_standard +# define RUNOPS_DEFAULT Perl_runops_standard #endif #ifdef MYMALLOC @@ -1851,33 +1938,40 @@ typedef Sighandler_t Sigsave_t; */ #ifndef PERL_OBJECT -typedef int (*runops_proc_t) _((void)); -int runops_standard _((void)); +typedef int (*runops_proc_t) (pTHX); +int Perl_runops_standard (pTHX); #ifdef DEBUGGING -int runops_debug _((void)); +int Perl_runops_debug (pTHX); #endif #endif - /* _ (for $_) must be first in the following list (DEFSV requires it) */ #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" -/* 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)) \ - || defined(__sgi) || defined(__DGUX) -extern char ** environ; /* environment variables supplied via exec */ -#endif -#else -# if defined(NeXT) && defined(__DYNAMIC__) - -# include +/* NeXT has problems with crt0.o globals */ +#if defined(__DYNAMIC__) && \ + (defined(NeXT) || defined(__NeXT__) || defined(__APPLE__)) +# if defined(NeXT) || defined(__NeXT) +# include +# define environ (*environ_pointer) EXT char *** environ_pointer; -# define environ (*environ_pointer) +# else +# if defined(__APPLE__) +# include /* for the env array */ +# define environ (*_NSGetEnviron()) +# endif # endif -#endif /* environ processing */ - +#else + /* VMS and some other platforms don't use the environ array */ +# if !defined(VMS) +# if !defined(DONT_DECLARE_STD) || \ + (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \ + defined(__sgi) || \ + defined(__DGUX) +extern char ** environ; /* environment variables supplied via exec */ +# endif +# endif +#endif /* handy constants */ EXTCONST char PL_warn_uninit[] @@ -1913,6 +2007,10 @@ EXTCONST char PL_no_func[] EXTCONST char PL_no_myglob[] INIT("\"my\" variable %s can't be in a package"); +EXTCONST char PL_uuemap[65] + INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); + + #ifdef DOINIT EXT char *PL_sig_name[] = { SIG_NAME }; EXT int PL_sig_num[] = { SIG_NUM }; @@ -2182,7 +2280,8 @@ enum { /* pass one of these to get_vtbl */ want_vtbl_mutex, #endif want_vtbl_regdata, - want_vtbl_regdatum + want_vtbl_regdatum, + want_vtbl_backref }; /* Note: the lowest 8 bits are reserved for @@ -2219,16 +2318,16 @@ enum { /* pass one of these to get_vtbl */ /* Enable variables which are pointers to functions */ #ifdef PERL_OBJECT -typedef regexp*(CPerlObj::*regcomp_t) _((char* exp, char* xend, PMOP* pm)); -typedef I32 (CPerlObj::*regexec_t) _((regexp* prog, char* stringarg, - char* strend, char* strbeg, - I32 minend, SV* screamer, void* data, - U32 flags)); +typedef regexp*(CPerlObj::*regcomp_t) (char* exp, char* xend, PMOP* pm); +typedef I32 (CPerlObj::*regexec_t) (regexp* prog, char* stringarg, + char* strend, char* strbeg, + I32 minend, SV* screamer, void* data, + U32 flags); #else -typedef regexp*(*regcomp_t) _((char* exp, char* xend, PMOP* pm)); -typedef I32 (*regexec_t) _((regexp* prog, char* stringarg, char* strend, char* - strbeg, I32 minend, SV* screamer, void* data, - U32 flags)); +typedef regexp*(*regcomp_t) (pTHX_ char* exp, char* xend, PMOP* pm); +typedef I32 (*regexec_t) (pTHX_ regexp* prog, char* stringarg, char* strend, char* + strbeg, I32 minend, SV* screamer, void* data, + U32 flags); #endif @@ -2240,18 +2339,18 @@ typedef I32 (*regexec_t) _((regexp* prog, char* stringarg, char* strend, char* /* Interpreter exitlist entry */ typedef struct exitlistentry { #ifdef PERL_OBJECT - void (*fn) _((CPerlObj*, void*)); + void (*fn) (CPerlObj*, void*); #else - void (*fn) _((void*)); + void (*fn) (pTHX_ void*); #endif void *ptr; } PerlExitListEntry; #ifdef PERL_OBJECT -extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*)); +extern "C" CPerlObj* perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); #ifdef PERL_OBJECT -typedef int (CPerlObj::*runops_proc_t) _((void)); +typedef int (CPerlObj::*runops_proc_t) (void); #endif /* PERL_OBJECT */ #undef EXT @@ -2277,7 +2376,7 @@ struct perl_vars { EXT struct perl_vars PL_Vars; EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); #else /* PERL_CORE */ -#if !defined(__GNUC__) || !defined(WIN32) +#if !defined(__GNUC__) || !(defined(WIN32) || defined(CYGWIN32)) EXT #endif /* WIN32 */ struct perl_vars *PL_VarsPtr; @@ -2326,10 +2425,45 @@ typedef void *Thread; #include "thread.h" #include "pp.h" + +#ifndef PERL_CALLCONV +# define PERL_CALLCONV +#endif + +#ifdef PERL_OBJECT +# define VIRTUAL virtual PERL_CALLCONV +#else +# define VIRTUAL PERL_CALLCONV +START_EXTERN_C +#endif + +#ifndef NEXT30_NO_ATTRIBUTE +# ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ +# ifdef __attribute__ /* Avoid possible redefinition errors */ +# undef __attribute__ +# endif +# define __attribute__(attr) +# endif +#endif + +#ifdef USE_PURE_BISON +int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp); +#endif + +typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*); +typedef void (*SVFUNC_t) (pTHX_ SV*); +typedef I32 (*SVCOMPARE_t) (pTHX_ SV*, SV*); +typedef void (*XSINIT_t) (pTHX); +typedef void (*ATEXIT_t) (pTHX_ void*); +typedef void (*XSUBADDR_t) (pTHX_ CV *); + #include "proto.h" -#define Perl_sv_setptrobj(rv,ptr,name) Perl_sv_setref_iv(rv,name,(IV)ptr) -#define Perl_sv_setptrref(rv,ptr) Perl_sv_setref_iv(rv,Nullch,(IV)ptr) +#include "pp_proto.h" + +#ifndef PERL_OBJECT +END_EXTERN_C +#endif /* The following must follow proto.h as #defines mess up syntax */ @@ -2388,98 +2522,87 @@ PERLVAR(object_compatibility[30], char) #undef PERLVARI #undef PERLVARIC -#if defined(HASATTRIBUTE) && defined(WIN32) -/* - * This provides a layer of functions and macros to ensure extensions will - * get to use the same RTL functions as the core. - * It has to go here or #define of printf messes up __attribute__ - * stuff in proto.h - */ -#ifndef PERL_OBJECT -# include -#endif /* PERL_OBJECT */ -#endif /* WIN32 */ - #ifdef DOINIT -EXT MGVTBL PL_vtbl_sv = {magic_get, - magic_set, - magic_len, +EXT MGVTBL PL_vtbl_sv = {Perl_magic_get, + Perl_magic_set, + Perl_magic_len, 0, 0}; -EXT MGVTBL PL_vtbl_env = {0, magic_set_all_env, - 0, magic_clear_all_env, +EXT MGVTBL PL_vtbl_env = {0, Perl_magic_set_all_env, + 0, Perl_magic_clear_all_env, 0}; -EXT MGVTBL PL_vtbl_envelem = {0, magic_setenv, - 0, magic_clearenv, +EXT MGVTBL PL_vtbl_envelem = {0, Perl_magic_setenv, + 0, Perl_magic_clearenv, 0}; EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0}; -EXT MGVTBL PL_vtbl_sigelem = {magic_getsig, - magic_setsig, - 0, magic_clearsig, +EXT MGVTBL PL_vtbl_sigelem = {Perl_magic_getsig, + Perl_magic_setsig, + 0, Perl_magic_clearsig, 0}; -EXT MGVTBL PL_vtbl_pack = {0, 0, magic_sizepack, magic_wipepack, +EXT MGVTBL PL_vtbl_pack = {0, 0, Perl_magic_sizepack, Perl_magic_wipepack, 0}; -EXT MGVTBL PL_vtbl_packelem = {magic_getpack, - magic_setpack, - 0, magic_clearpack, +EXT MGVTBL PL_vtbl_packelem = {Perl_magic_getpack, + Perl_magic_setpack, + 0, Perl_magic_clearpack, 0}; -EXT MGVTBL PL_vtbl_dbline = {0, magic_setdbline, +EXT MGVTBL PL_vtbl_dbline = {0, Perl_magic_setdbline, 0, 0, 0}; -EXT MGVTBL PL_vtbl_isa = {0, magic_setisa, - 0, magic_setisa, +EXT MGVTBL PL_vtbl_isa = {0, Perl_magic_setisa, + 0, Perl_magic_setisa, 0}; -EXT MGVTBL PL_vtbl_isaelem = {0, magic_setisa, +EXT MGVTBL PL_vtbl_isaelem = {0, Perl_magic_setisa, 0, 0, 0}; -EXT MGVTBL PL_vtbl_arylen = {magic_getarylen, - magic_setarylen, +EXT MGVTBL PL_vtbl_arylen = {Perl_magic_getarylen, + Perl_magic_setarylen, 0, 0, 0}; -EXT MGVTBL PL_vtbl_glob = {magic_getglob, - magic_setglob, +EXT MGVTBL PL_vtbl_glob = {Perl_magic_getglob, + Perl_magic_setglob, 0, 0, 0}; -EXT MGVTBL PL_vtbl_mglob = {0, magic_setmglob, +EXT MGVTBL PL_vtbl_mglob = {0, Perl_magic_setmglob, 0, 0, 0}; -EXT MGVTBL PL_vtbl_nkeys = {magic_getnkeys, - magic_setnkeys, +EXT MGVTBL PL_vtbl_nkeys = {Perl_magic_getnkeys, + Perl_magic_setnkeys, 0, 0, 0}; -EXT MGVTBL PL_vtbl_taint = {magic_gettaint,magic_settaint, +EXT MGVTBL PL_vtbl_taint = {Perl_magic_gettaint,Perl_magic_settaint, 0, 0, 0}; -EXT MGVTBL PL_vtbl_substr = {magic_getsubstr, magic_setsubstr, +EXT MGVTBL PL_vtbl_substr = {Perl_magic_getsubstr, Perl_magic_setsubstr, 0, 0, 0}; -EXT MGVTBL PL_vtbl_vec = {magic_getvec, - magic_setvec, +EXT MGVTBL PL_vtbl_vec = {Perl_magic_getvec, + Perl_magic_setvec, 0, 0, 0}; -EXT MGVTBL PL_vtbl_pos = {magic_getpos, - magic_setpos, +EXT MGVTBL PL_vtbl_pos = {Perl_magic_getpos, + Perl_magic_setpos, 0, 0, 0}; -EXT MGVTBL PL_vtbl_bm = {0, magic_setbm, +EXT MGVTBL PL_vtbl_bm = {0, Perl_magic_setbm, 0, 0, 0}; -EXT MGVTBL PL_vtbl_fm = {0, magic_setfm, +EXT MGVTBL PL_vtbl_fm = {0, Perl_magic_setfm, 0, 0, 0}; -EXT MGVTBL PL_vtbl_uvar = {magic_getuvar, - magic_setuvar, +EXT MGVTBL PL_vtbl_uvar = {Perl_magic_getuvar, + Perl_magic_setuvar, 0, 0, 0}; #ifdef USE_THREADS -EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, magic_mutexfree}; +EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, Perl_magic_mutexfree}; #endif /* USE_THREADS */ -EXT MGVTBL PL_vtbl_defelem = {magic_getdefelem,magic_setdefelem, +EXT MGVTBL PL_vtbl_defelem = {Perl_magic_getdefelem,Perl_magic_setdefelem, 0, 0, 0}; -EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, magic_freeregexp}; -EXT MGVTBL PL_vtbl_regdata = {0, 0, magic_regdata_cnt, 0, 0}; -EXT MGVTBL PL_vtbl_regdatum = {magic_regdatum_get, 0, 0, 0, 0}; +EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, Perl_magic_freeregexp}; +EXT MGVTBL PL_vtbl_regdata = {0, 0, Perl_magic_regdata_cnt, 0, 0}; +EXT MGVTBL PL_vtbl_regdatum = {Perl_magic_regdatum_get, 0, 0, 0, 0}; #ifdef USE_LOCALE_COLLATE EXT MGVTBL PL_vtbl_collxfrm = {0, - magic_setcollxfrm, + Perl_magic_setcollxfrm, 0, 0, 0}; #endif -#ifdef OVERLOAD -EXT MGVTBL PL_vtbl_amagic = {0, magic_setamagic, - 0, 0, magic_setamagic}; -EXT MGVTBL PL_vtbl_amagicelem = {0, magic_setamagic, - 0, 0, magic_setamagic}; -#endif /* OVERLOAD */ +EXT MGVTBL PL_vtbl_amagic = {0, Perl_magic_setamagic, + 0, 0, Perl_magic_setamagic}; +EXT MGVTBL PL_vtbl_amagicelem = {0, Perl_magic_setamagic, + 0, 0, Perl_magic_setamagic}; + +EXT MGVTBL PL_vtbl_backref = {0, 0, + 0, 0, Perl_magic_killbackrefs}; #else /* !DOINIT */ @@ -2518,14 +2641,12 @@ EXT MGVTBL PL_vtbl_regdatum; EXT MGVTBL PL_vtbl_collxfrm; #endif -#ifdef OVERLOAD EXT MGVTBL PL_vtbl_amagic; EXT MGVTBL PL_vtbl_amagicelem; -#endif /* OVERLOAD */ -#endif /* !DOINIT */ +EXT MGVTBL PL_vtbl_backref; -#ifdef OVERLOAD +#endif /* !DOINIT */ enum { fallback_amg, abs_amg, @@ -2661,8 +2782,6 @@ typedef struct am_table_short AMTS; # endif #endif /* _FASTMATH */ -#endif /* OVERLOAD */ - #define PERLDB_ALL 0x3f /* No _NONAME, _GOTO */ #define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */ #define PERLDBf_LINE 0x02 /* Keep line #. */ @@ -2688,14 +2807,14 @@ typedef struct am_table_short AMTS; #define SET_NUMERIC_STANDARD() \ STMT_START { \ - if (! PL_numeric_standard) \ - perl_set_numeric_standard(); \ + if (! PL_numeric_standard) \ + set_numeric_standard(); \ } STMT_END #define SET_NUMERIC_LOCAL() \ STMT_START { \ if (! PL_numeric_local) \ - perl_set_numeric_local(); \ + set_numeric_local(); \ } STMT_END #else /* !USE_LOCALE_NUMERIC */ @@ -2750,9 +2869,39 @@ typedef struct am_table_short AMTS; # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf) # endif # endif -# ifndef Semctl /* Place our bets on the semun horse. */ -# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) -# endif #endif +/* Mention + + INSTALL_USR_BIN_PERL + + I_SYS_MMAN + HAS_MMAP + HAS_MUNMAP + HAS_MPROTECT + HAS_MSYNC + HAS_MADVISE + Mmap_t + + here so that Configure picks them up. */ + +#ifdef IAMSUID + +#ifdef I_SYS_STATVFS +# include /* for f?statvfs() */ +#endif +#ifdef I_SYS_MOUNT +# include /* for *BSD f?statfs() */ +#endif +#ifdef I_MNTENT +# include /* for getmntent() */ +#endif + +#endif /* IAMSUID */ + +/* and finally... */ +#define PERL_PATCHLEVEL_H_IMPLICIT +#include "patchlevel.h" +#undef PERL_PATCHLEVEL_H_IMPLICIT + #endif /* Include guard */