X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=7ec37501736722fab2326e659ac1f78148d693f0;hb=e0c198038146b7a4a8cc36d4608b35da0fadeaad;hp=cd46b7d471d601632dea0d0bdd79e35e6ac43aac;hpb=864dbfa3ca8032ef66f7aa86961933b19b962357;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index cd46b7d..7ec3750 100644 --- a/perl.h +++ b/perl.h @@ -20,6 +20,53 @@ #define USE_STDIO #endif /* PERL_FOR_X2P */ +#define VOIDUSED 1 +#include "config.h" + +/* See L for detailed notes on + * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */ + +#ifdef USE_THREADS +# ifndef PERL_IMPLICIT_CONTEXT +# define PERL_IMPLICIT_CONTEXT +# endif +# ifndef PERL_IMPLICIT_SYS +# if defined(WIN32) && !defined(__MINGW32__) +# define PERL_IMPLICIT_SYS /* XXX not implemented everywhere yet */ +# endif +# endif +#endif + +#if defined(MULTIPLICITY) +# ifndef PERL_IMPLICIT_CONTEXT +# define PERL_IMPLICIT_CONTEXT +# endif +# ifndef PERL_IMPLICIT_SYS +# if defined(WIN32) && !defined(__MINGW32__) +# define PERL_IMPLICIT_SYS /* XXX not implemented everywhere yet */ +# endif +# endif +#endif + +#ifdef PERL_CAPI +# undef PERL_OBJECT +# ifndef PERL_IMPLICIT_CONTEXT +# define PERL_IMPLICIT_CONTEXT +# endif +# ifndef PERL_IMPLICIT_SYS +# define PERL_IMPLICIT_SYS +# endif +#endif + +#ifdef PERL_OBJECT +# ifndef PERL_IMPLICIT_CONTEXT +# define PERL_IMPLICIT_CONTEXT +# endif +# ifndef PERL_IMPLICIT_SYS +# define PERL_IMPLICIT_SYS +# endif +#endif + #ifdef PERL_OBJECT /* PERL_OBJECT explained - DickH and DougL @ ActiveState.com @@ -43,8 +90,8 @@ the perl interpreter. | Perl Host | +-----------+ ^ - | - v + | + v +-----------+ +-----------+ | Perl Core |<->| Extension | +-----------+ +-----------+ ... @@ -98,23 +145,46 @@ functions are now member functions of the PERL_OBJECT. class CPerlObj; #define STATIC -#define CPERLscope(x) CPerlObj::x -#define CPERLproto CPerlObj * -#define _CPERLproto ,CPERLproto -#define CPERLarg CPerlObj *pPerl -#define CPERLarg_ CPERLarg, -#define _CPERLarg ,CPERLarg -#define PERL_OBJECT_THIS this -#define _PERL_OBJECT_THIS ,this -#define PERL_OBJECT_THIS_ this, -#define CALL_FPTR(fptr) (this->*fptr) +#define CPERLscope(x) CPerlObj::x +#define CALL_FPTR(fptr) (this->*fptr) + +#define pTHXo CPerlObj *pPerl +#define pTHXo_ pTHXo, +#define aTHXo this +#define aTHXo_ this, +#define PERL_OBJECT_THIS aTHXo +#define PERL_OBJECT_THIS_ aTHXo_ +#define dTHXoa(a) pTHXo = a +#define dTHXo dTHXoa(PERL_GET_THX) + +#define pTHXx void +#define pTHXx_ +#define aTHXx +#define aTHXx_ #else /* !PERL_OBJECT */ +#ifdef PERL_IMPLICIT_CONTEXT +# ifdef USE_THREADS +struct perl_thread; +# define pTHX register struct perl_thread *thr +# define aTHX thr +# define dTHR dNOOP +# else +# ifndef MULTIPLICITY +# define MULTIPLICITY +# endif +# define pTHX register PerlInterpreter *my_perl +# define aTHX my_perl +# endif +# define dTHXa(a) pTHX = a +# define dTHX dTHXa(PERL_GET_THX) +# define pTHX_ pTHX, +# define aTHX_ aTHX, +#endif + #define STATIC static #define CPERLscope(x) x -#define CPERLproto -#define _CPERLproto #define CPERLarg void #define CPERLarg_ #define _CPERLarg @@ -128,13 +198,37 @@ class CPerlObj; #define CALLRUNOPS CALL_FPTR(PL_runops) #define CALLREGCOMP CALL_FPTR(PL_regcompp) #define CALLREGEXEC CALL_FPTR(PL_regexecp) +#define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start) +#define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string) +#define CALLREGFREE CALL_FPTR(PL_regfree) #define CALLPROTECT CALL_FPTR(PL_protect) -#define VOIDUSED 1 -#include "config.h" +#define NOOP (void)0 +#define dNOOP extern int Perl___notused -#if !defined(PERL_FOR_X2P) -# include "embed.h" +#ifndef pTHX +# define pTHX void +# define pTHX_ +# define aTHX +# define aTHX_ +# define dTHXa(a) dNOOP +# define dTHX dNOOP +#endif + +#ifndef pTHXo +# define pTHXo pTHX +# define pTHXo_ pTHX_ +# define aTHXo aTHX +# define aTHXo_ aTHX_ +# define dTHXo dTHX +#endif + +#ifndef pTHXx +# define pTHXx register PerlInterpreter *my_perl +# define pTHXx_ pTHXx, +# define aTHXx my_perl +# define aTHXx_ aTHXx, +# define dTHXx dTHX #endif #undef START_EXTERN_C @@ -147,7 +241,7 @@ class CPerlObj; #else # define START_EXTERN_C # define END_EXTERN_C -# define EXTERN_C +# define EXTERN_C extern #endif #ifdef OP_IN_REGISTER @@ -181,8 +275,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # endif #endif -#define NOOP (void)0 - +#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END #define WITH_THR(s) STMT_START { dTHR; s; } STMT_END /* @@ -219,15 +312,15 @@ 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) || defined(CYGWIN32) +#if defined(MSDOS) || defined(atarist) || defined(WIN32) #define DOSISH 1 #endif -#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) +#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) # define STANDARD_C 1 #endif -#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) +#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) # define DONT_DECLARE_STD 1 #endif @@ -300,7 +393,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_THREADS) && defined(PTHREAD_H_FIRST) +#if defined(USE_THREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) # include #endif @@ -324,8 +417,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,17 +470,36 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # include #endif +#if !defined(PERL_FOR_X2P) && !defined(WIN32) +# include "embed.h" +#endif + #define MEM_SIZE Size_t +#if defined(STANDARD_C) && defined(I_STDDEF) +# include +# define STRUCT_OFFSET(s,m) offsetof(s,m) +#else +# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) +#endif + +#if defined(I_STRING) || defined(__cplusplus) +# include +#else +# include +#endif + /* 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 PERL_POLLUTE_MALLOC +# ifndef PERL_EXTMALLOC_DEF # define Perl_malloc malloc # define Perl_calloc calloc # define Perl_realloc realloc # define Perl_mfree free +# endif # else # define EMBEDMYMALLOC /* for compatibility */ # endif @@ -411,19 +521,6 @@ Free_t Perl_mfree (Malloc_t where); # define safefree safesysfree #endif /* MYMALLOC */ -#if defined(STANDARD_C) && defined(I_STDDEF) -# include -# define STRUCT_OFFSET(s,m) offsetof(s,m) -#else -# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) -#endif - -#if defined(I_STRING) || defined(__cplusplus) -# include -#else -# include -#endif - #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr) #define strchr index #define strrchr rindex @@ -591,16 +688,16 @@ Free_t Perl_mfree (Malloc_t where); #ifdef USE_THREADS # define ERRSV (thr->errsv) -# define ERRHV (thr->errhv) # define DEFSV THREADSV(0) # define SAVE_DEFSV save_threadsv(0) #else # define ERRSV GvSV(PL_errgv) -# define ERRHV GvHV(PL_errgv) # define DEFSV GvSV(PL_defgv) # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif /* USE_THREADS */ +#define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */ + #ifndef errno extern int errno; /* ANSI allows errno to be an lvalue expr. * For example in multithreaded environments @@ -798,118 +895,23 @@ Free_t Perl_mfree (Malloc_t where); #include #endif -/* XXX QUAD stuff is not currently supported on most systems. - Specifically, perl internals don't support long long. Among - the many problems is that some compilers support long long, - but the underlying library functions (such as sprintf) don't. - Some things do work (such as quad pack/unpack on convex); - also some systems use long long for the fpos_t typedef. That - seems to work too. - +/* The IV type is supposed to be long enough to hold any integral value or a pointer. --Andy Dougherty August 1996 */ -/* Much more 64-bit probing added. Now we should get Quad_t - in most systems: int64_t, long long, long, int, will do. - - Beware of LP32 systems (ILP32, ILP32LL64). Such systems have been - used to sizeof(long) == sizeof(foo*). This is a bad assumption - because then IV/UV have been 32 bits, too. Which, in turn means - that even if the system has quads (e.g. long long), IV cannot be a - quad. Introducing a 64-bit IV (because of long long existing) - will introduce binary incompatibility. - - Summary: a long long system needs to add -DUSE_LONG_LONG to $ccflags - to get quads -- and if its pointers are still 32 bits, this will break - binary compatibility. Casting an IV (a long long) to a pointer will - truncate half of the IV away. - - --jhi September 1998 */ - -#if INTSIZE == 4 && LONGSIZE == 4 && PTRSIZE == 4 -# define PERL_ILP32 -# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8 -# define PERL_ILP32LL64 -# endif -#endif - -#if LONGSIZE == 8 && PTRSIZE == 8 -# define PERL_LP64 -# if INTSIZE == 8 -# define PERL_ILP64 -# endif -#endif - -#ifndef Quad_t -# if LONGSIZE == 8 -# define Quad_t long -# define Uquad_t unsigned long -# define PERL_QUAD_IS_LONG -# endif -#endif - -#ifndef Quad_t -# if INTSIZE == 8 -# define Quad_t int -# define Uquad_t unsigned int -# define PERL_QUAD_IS_INT -# endif -#endif - -#ifndef Quad_t -# ifdef USE_LONG_LONG /* See above note about LP32. --jhi */ -# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8 -# define Quad_t long long -# define Uquad_t unsigned long long -# define PERL_QUAD_IS_LONG_LONG -# endif -# endif -#endif - -#ifndef Quad_t -# ifdef HAS_INT64_T -# define Quad_t int64_t -# define Uquad_t uint64_t -# define PERL_QUAD_IS_INT64_T -# endif -#endif - -#ifdef Quad_t -# define HAS_QUAD -# ifndef Uquad_t - /* Note that if your Quad_t is a typedef (not a #define) you *MUST* - * have defined by now Uquad_t yourself because 'unsigned type' - * is illegal. */ -# define Uquad_t unsigned Quad_t -# endif -#endif +typedef IVTYPE IV; +typedef UVTYPE UV; #if defined(USE_64_BITS) && defined(HAS_QUAD) -# ifdef PERL_QUAD_IS_LONG /* LP64 */ - typedef long IV; - typedef unsigned long UV; -# else -# ifdef PERL_QUAD_IS_INT /* ILP64 */ - typedef int IV; - typedef unsigned int UV; -# else -# ifdef PERL_QUAD_IS_LONG_LONG /* LL64 */ - typedef long long IV; - typedef unsigned long long UV; -# else -# ifdef PERL_QUAD_IS_INT64_T /* C9X */ - typedef int64_t IV; - typedef uint64_t UV; -# endif -# endif -# endif -# endif -# if defined(PERL_QUAD_IS_INT64_T) && defined(INT64_MAX) +# if QUADCASE == 4 && defined(INT64_MAX) /* quad is int64_t */ # define IV_MAX INT64_MAX # define IV_MIN INT64_MIN # define UV_MAX UINT64_MAX +# ifndef UINT64_MIN +# define UINT64_MIN 0 +# endif # define UV_MIN UINT64_MIN # else # define IV_MAX PERL_QUAD_MAX @@ -917,13 +919,20 @@ Free_t Perl_mfree (Malloc_t where); # define UV_MAX PERL_UQUAD_MAX # define UV_MIN PERL_UQUAD_MIN # endif +# define IV_IS_QUAD +# define UV_IS_QUAD #else - typedef long IV; - typedef unsigned long UV; -# if defined(INT32_MAX) && LONGSIZE == 4 +# if defined(INT32_MAX) && IVSIZE == 4 # define IV_MAX INT32_MAX # define IV_MIN INT32_MIN -# define UV_MAX UINT32_MAX +# ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ +# define UV_MAX UINT32_MAX +# else +# define UV_MAX 4294967295U +# endif +# ifndef UINT32_MIN +# define UINT32_MIN 0 +# endif # define UV_MIN UINT32_MIN # else # define IV_MAX PERL_LONG_MAX @@ -931,6 +940,154 @@ Free_t Perl_mfree (Malloc_t where); # define UV_MAX PERL_ULONG_MAX # define UV_MIN PERL_ULONG_MIN # endif +# if IVSIZE == 8 +# define IV_IS_QUAD +# define UV_IS_QUAD +# ifndef HAS_QUAD +# define HAS_QUAD +# endif +# else +# undef IV_IS_QUAD +# undef UV_IS_QUAD +# undef HAS_QUAD +# endif +#endif + +#define IV_DIG (BIT_DIGITS(IVSIZE * 8)) +#define UV_DIG (BIT_DIGITS(UVSIZE * 8)) + +/* + * The macros INT2PTR and NUM2PTR are (despite their names) + * bi-directional: they will convert int/float to or from pointers. + * However the conversion to int/float are named explicitly: + * PTR2IV, PTR2UV, PTR2NV. + * + * For int conversions we do not need two casts if pointers are + * the same size as IV and UV. Otherwise we need an explicit + * cast (PTRV) to avoid compiler warnings. + */ +#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) +# define PTRV UV +# define INT2PTR(any,d) (any)(d) +#else +# if PTRSIZE == LONGSIZE +# define PTRV unsigned long +# else +# define PTRV unsigned +# endif +# define INT2PTR(any,d) (any)(PTRV)(d) +#endif +#define NUM2PTR(any,d) (any)(PTRV)(d) +#define PTR2IV(p) INT2PTR(IV,p) +#define PTR2UV(p) INT2PTR(UV,p) +#define PTR2NV(p) NUM2PTR(NV,p) + +#ifdef USE_LONG_DOUBLE +# if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)) +# undef USE_LONG_DOUBLE /* Ouch! */ +# endif +#endif + +#ifdef OVR_DBL_DIG +/* Use an overridden DBL_DIG */ +# ifdef DBL_DIG +# undef DBL_DIG +# endif +# 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) +*/ +#ifdef I_LIMITS +#include +#endif +#ifdef I_FLOAT +#include +#endif +#ifndef HAS_DBL_DIG +#define DBL_DIG 15 /* A guess that works lots of places */ +#endif +#endif +#ifdef I_FLOAT +#include +#endif +#ifndef HAS_DBL_DIG +#define DBL_DIG 15 /* A guess that works lots of places */ +#endif + +#ifdef OVR_LDBL_DIG +/* Use an overridden LDBL_DIG */ +# ifdef LDBL_DIG +# undef LDBL_DIG +# endif +# define LDBL_DIG OVR_LDBL_DIG +#else +/* The following is all to get LDBL_DIG, in order to pick a nice + default value for printing floating point numbers in Gconvert. + (see config.h) +*/ +# ifdef I_LIMITS +# include +# endif +# ifdef I_FLOAT +# include +# endif +# ifndef HAS_LDBL_DIG +# if LONG_DOUBLESIZE == 10 +# define LDBL_DIG 18 /* assume IEEE */ +# else +# if LONG_DOUBLESIZE == 12 +# define LDBL_DIG 18 /* gcc? */ +# else +# if LONG_DOUBLESIZE == 16 +# define LDBL_DIG 33 /* assume IEEE */ +# else +# if LONG_DOUBLESIZE == DOUBLESIZE +# define LDBL_DIG DBL_DIG /* bummer */ +# endif +# endif +# endif +# endif +# endif +#endif + +typedef NVTYPE NV; + +#ifdef USE_LONG_DOUBLE +# define NV_DIG LDBL_DIG +# ifdef HAS_SQRTL +# define Perl_modf modfl +# define Perl_frexp frexpl +# define Perl_cos cosl +# define Perl_sin sinl +# define Perl_sqrt sqrtl +# define Perl_exp expl +# define Perl_log logl +# define Perl_atan2 atan2l +# define Perl_pow powl +# define Perl_floor floorl +# define Perl_fmod fmodl +# endif +#else +# define NV_DIG DBL_DIG +# define Perl_modf modf +# define Perl_frexp frexp +# define Perl_cos cos +# define Perl_sin sin +# define Perl_sqrt sqrt +# define Perl_exp exp +# define Perl_log log +# define Perl_atan2 atan2 +# define Perl_pow pow +# define Perl_floor floor +# define Perl_fmod fmod +#endif + +#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && defined(HAS_ATOLF) +# define Perl_atof atolf +#else +# define Perl_atof atof #endif /* Previously these definitions used hardcoded figures. @@ -1102,7 +1259,7 @@ Free_t Perl_mfree (Malloc_t where); # endif #endif -#ifdef HAS_QUAD +#ifdef UV_IS_QUAD # ifdef UQUAD_MAX # define PERL_UQUAD_MAX ((UV)UQUAD_MAX) @@ -1134,18 +1291,13 @@ typedef struct unop UNOP; typedef struct binop BINOP; typedef struct listop LISTOP; typedef struct logop LOGOP; -typedef struct condop CONDOP; typedef struct pmop PMOP; typedef struct svop SVOP; -typedef struct gvop GVOP; +typedef struct padop PADOP; typedef struct pvop PVOP; typedef struct loop LOOP; -typedef struct Outrec Outrec; typedef struct interpreter PerlInterpreter; -#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; @@ -1174,140 +1326,113 @@ typedef struct xpvfm XPVFM; typedef struct xpvio XPVIO; typedef struct mgvtbl MGVTBL; typedef union any ANY; +typedef struct svtblent SVTBLENT; +typedef struct svtbl SVTBL; #include "handy.h" -/* Some day when we have more 64-bit experience under our belts we may - * be able to merge some of the USE_64_BIT_{FILES,OFFSETS,STDIO,DBM}. At - * the moment (Oct 1998), though, keep them separate. --jhi - */ -#ifdef USE_64_BITS -# ifdef USE_64_BIT_FILES -# ifndef USE_64_BIT_OFFSETS -# define USE_64_BIT_OFFSETS -# endif -# ifndef USE_64_BIT_STDIO -# define USE_64_BIT_STDIO -# endif -# ifndef USE_64_BIT_DBM -# define USE_64_BIT_DBM -# endif +#if defined(USE_LARGE_FILES) +# define USE_64_BIT_RAWIO /* Explicit */ +# define USE_64_BIT_STDIO +#endif + +#if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO) +# define USE_64_BIT_RAWIO /* Implicit */ +#endif + +/* Do we need FSEEKSIZE? */ + +/* I couldn't find any -Ddefine or -flags in IRIX 6.5 that would + * have done the necessary symbol renaming using cpp. --jhi */ +#ifdef __sgi +#define USE_FOPEN64 +#define USE_FSEEK64 +#define USE_FTELL64 +#define USE_FSETPOS64 +#define USE_FGETPOS64 +#define USE_TMPFILE64 +#define USE_FREOPEN64 +#endif + +#ifdef USE_64_BIT_RAWIO +# ifdef HAS_OFF64_T +# undef Off_t +# define Off_t off64_t +# undef LSEEKSIZE +# define LSEEKSIZE 8 # endif -/* Mention LSEEKSIZE here to get it included in %Config. */ -# ifdef USE_64_BIT_OFFSETS -# ifdef HAS_FSTAT64 -# define fstat fstat64 -# endif -# ifdef HAS_FTRUNCATE64 -# define ftruncate ftruncate64 -# endif -# ifdef HAS_LSEEK64 -# define lseek lseek64 -# ifdef HAS_OFF64_T -# undef Off_t -# define Off_t off64_t -# endif -# endif -# ifdef HAS_LSTAT64 -# define lstat lstat64 -# endif - /* Some systems have open64() in libc but use that only - * for true LP64 mode, in mixed mode (ILP32LL64, for example) - * they use the vanilla open(). Such systems should undefine - * d_open64 in their hints files. --jhi */ -# if defined(HAS_OPEN64) -# define open open64 -# endif -# ifdef HAS_OPENDIR64 -# define opendir opendir64 -# endif -# ifdef HAS_READDIR64 -# define readdir readdir64 -# ifdef HAS_STRUCT_DIRENT64 -# define dirent dirent64 -# endif -# endif -# ifdef HAS_SEEKDIR64 -# define seekdir seekdir64 -# endif -# ifdef HAS_STAT64 -# define stat stat64 /* Affects also struct stat, hopefully okay. */ -# endif -# ifdef HAS_TELLDIR64 -# define telldir telldir64 -# endif -# ifdef HAS_TRUNCATE64 -# define truncate truncate64 -# endif - /* flock is not #defined here to be flock64 because it seems - that a system may have struct flock64 but still use flock() - and not flock64(). The actual flocking code in pp_sys.c - must be changed. Also lockf and lockf64 must be dealt - with in pp_sys.c. --jhi */ -# endif -# ifdef USE_64_BIT_STDIO -# ifdef HAS_FGETPOS64 -# define fgetpos fgetpos64 -# endif -# ifdef HAS_FOPEN64 -# define fopen fopen64 -# endif -# ifdef HAS_FREOPEN64 -# define freopen freopen64 -# endif -# ifdef HAS_FSEEK64 -# define fseek fseek64 -# endif -# ifdef HAS_FSEEKO64 -# define fseeko fseeko64 -# endif -# ifdef HAS_FSETPOS64 -# define fsetpos fsetpos64 -# endif -# ifdef HAS_FTELL64 -# define ftell ftell64 -# endif -# ifdef HAS_FTELLO64 -# define ftello ftello64 -# endif -# ifdef HAS_TMPFILE64 -# define tmpfile tmpfile64 -# endif +/* Most 64-bit environments have defines like _LARGEFILE_SOURCE that + * will trigger defines like the ones below. Some 64-bit environments, + * however, do not. Therefore we have to explicitly mix and match. */ +# if defined(USE_OPEN64) +# define open open64 # endif -# ifdef USE_64_BIT_DBM -# ifdef HAS_DBMINIT64 -# define dbminit dbminit64 -# endif -# ifdef HAS_DBMCLOSE64 -# define dbmclose dbmclose64 -# endif -# ifdef HAS_FETCH64 -# define fetch fetch64 -# endif -# ifdef HAS_DELETE64 -# define delete delete64 -# endif -# ifdef HAS_STORE64 -# define store store64 -# endif -# ifdef HAS_FIRSTKEY64 -# define firstkey firstkey64 -# endif -# ifdef HAS_NEXTKEY64 -# define nextkey nextkey64 -# endif +# if defined(USE_LSEEK64) +# define lseek lseek64 +# endif +# if defined(USE_LLSEEK) +# define lseek llseek +# endif +# if defined(USE_STAT64) +# define stat stat64 +# endif +# if defined(USE_FSTAT64) +# define fstat fstat64 +# endif +# if defined(USE_LSTAT64) +# define lstat lstat64 +# endif +# if defined(USE_FLOCK64) +# define flock flock64 +# endif +# if defined(USE_LOCKF64) +# define lockf lockf64 +# endif +# if defined(USE_FCNTL64) +# define fcntl fcntl64 +# endif +# if defined(USE_TRUNCATE64) +# define truncate truncate64 +# endif +# if defined(USE_FTRUNCATE64) +# define ftruncate ftruncate64 # endif #endif -#ifdef PERL_OBJECT -typedef I32 (*filter_t) (CPerlObj*, int, SV *, int); -#else -typedef I32 (*filter_t) (int, SV *, int); +#ifdef USE_64_BIT_STDIO +# ifdef HAS_FPOS64_T +# undef Fpos_t +# define Fpos_t fpos64_t +# endif +/* Most 64-bit environments have defines like _LARGEFILE_SOURCE that + * will trigger defines like the ones below. Some 64-bit environments, + * however, do not. */ +# if defined(USE_FOPEN64) +# define fopen fopen64 +# endif +# if defined(USE_FSEEK64) +# define fseek fseek64 +# endif +# if defined(USE_FTELL64) +# define ftell ftell64 +# endif +# if defined(USE_FSETPOS64) +# define fsetpos fsetpos64 +# endif +# if defined(USE_FGETPOS64) +# define fgetpos fgetpos64 +# endif +# if defined(USE_TMPFILE64) +# define tmpfile tmpfile64 +# endif +# if defined(USE_FREOPEN64) +# define freopen freopen64 +# endif #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(OS2) +# include "iperlsys.h" +#endif #if defined(__OPEN_VM) # include "vmesa/vmesaish.h" @@ -1332,13 +1457,25 @@ typedef I32 (*filter_t) (int, SV *, int); # if defined(__VOS__) # include "vosish.h" # else -# include "unixish.h" +# if defined(EPOC) +# include "epocish.h" +# else +# include "unixish.h" +# endif # endif # endif # endif # endif #endif +#ifndef PERL_SYS_INIT3 +# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp) +#endif + +#ifndef PERL_SYS_INIT3 +# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp) +#endif + #ifndef MAXPATHLEN # ifdef PATH_MAX # ifdef _POSIX_PATH_MAX @@ -1361,10 +1498,6 @@ typedef I32 (*filter_t) (int, SV *, int); # endif #endif -#ifndef FUNC_NAME_TO_PTR -#define FUNC_NAME_TO_PTR(name) name -#endif - /* * USE_THREADS needs to be after unixish.h as includes * which defines NSIG - which will stop inclusion of @@ -1396,7 +1529,9 @@ typedef mutex_t perl_mutex; typedef condition_t perl_cond; typedef void * perl_key; # else /* Posix threads */ -# include +# ifdef I_PTHREAD +# include +# endif typedef pthread_t perl_os_thread; typedef pthread_mutex_t perl_mutex; typedef pthread_cond_t perl_cond; @@ -1406,7 +1541,11 @@ typedef pthread_key_t perl_key; # endif /* WIN32 */ # endif /* FAKE_THREADS */ #endif /* USE_THREADS */ - + +#ifdef WIN32 +#include "win32.h" +#endif + #ifdef VMS # define STATUS_NATIVE PL_statusvalue_vms # define STATUS_NATIVE_EXPORT \ @@ -1456,9 +1595,12 @@ typedef pthread_key_t perl_key; # define STATUS_ALL_FAILURE (PL_statusvalue = 1) #endif +#ifndef MEMBER_TO_FPTR +#define MEMBER_TO_FPTR(name) name +#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) @@ -1467,11 +1609,39 @@ typedef pthread_key_t perl_key; # ifdef FFLUSH_ALL # define PERL_FLUSHALL_FOR_CHILD my_fflush_all() # else -# define PERL_FLUSHALL_FOR_CHILD (void)0 +# define PERL_FLUSHALL_FOR_CHILD NOOP # endif # endif #endif +/* the traditional thread-unsafe notion of "current interpreter". + * XXX todo: a thread-safe version that fetches it from TLS (akin to THR) + * needs to be defined elsewhere (conditional on pthread_getspecific() + * availability). */ +#ifndef PERL_SET_INTERP +# define PERL_SET_INTERP(i) (PL_curinterp = (PerlInterpreter*)(i)) +#endif + +#ifndef PERL_GET_INTERP +# define PERL_GET_INTERP (PL_curinterp) +#endif + +#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX) +# ifdef USE_THREADS +# define PERL_GET_THX THR +# else +# ifdef MULTIPLICITY +# define PERL_GET_THX PERL_GET_INTERP +# else +# ifdef PERL_OBJECT +# define PERL_GET_THX ((CPerlObj*)PERL_GET_INTERP) +# else +# define PERL_GET_THX ((void*)0) +# endif +# 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. @@ -1492,6 +1662,18 @@ typedef pthread_key_t perl_key; # endif #endif +#if defined(CYGWIN) +/* 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 : FALSE) +#endif + #ifdef UNION_ANY_DEFINITION UNION_ANY_DEFINITION; #else @@ -1500,60 +1682,40 @@ union any { I32 any_i32; IV any_iv; long any_long; - void (CPERLscope(*any_dptr)) (void*); + void (*any_dptr) (void*); + void (*any_dxptr) (pTHXo_ void*); }; #endif #ifdef USE_THREADS #define ARGSproto struct perl_thread *thr #else -#define ARGSproto void +#define ARGSproto #endif /* USE_THREADS */ -#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 - -#ifndef pTHX -# define pTHX void -# define pTHX_ -# define _pTHX -#endif +typedef I32 (*filter_t) (pTHXo_ int, SV *, int); -#ifndef aTHX -# define aTHX -# define aTHX_ -# define _aTHX -#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)) -#ifndef STATIC -# define STATIC static +#if !defined(OS2) +# include "iperlsys.h" #endif - #include "regexp.h" #include "sv.h" #include "util.h" #include "form.h" #include "gv.h" #include "cv.h" -#ifndef PERL_OBJECT -#include "opcode.h" -#endif +#include "opnames.h" #include "op.h" #include "cop.h" #include "av.h" #include "hv.h" #include "mg.h" #include "scope.h" -#include "warning.h" +#include "warnings.h" #include "utf8.h" /* Current curly descriptor */ @@ -1581,28 +1743,22 @@ struct _sublex_info { typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ -/* Length of a variant. */ - -typedef struct { - I32 len_min; - I32 len_delta; - I32 pos_min; - I32 pos_delta; - SV *last_found; - I32 last_end; /* min value, <0 unless valid. */ - I32 last_start_min; - I32 last_start_max; - SV **longest; /* Either &l_fixed, or &l_float. */ - SV *longest_fixed; - I32 offset_fixed; - SV *longest_float; - I32 offset_float_min; - I32 offset_float_max; - I32 flags; -} scan_data_t; +struct scan_data_t; /* Used in S_* functions in regcomp.c */ typedef I32 CHECKPOINT; +struct svtblent { + struct svtblent* next; + SV* oldval; + SV* newval; +}; + +struct svtbl { + struct svtblent** tbl_ary; + UV tbl_max; + UV tbl_items; +}; + #if defined(iAPX286) || defined(M_I286) || defined(I80286) # define I286 #endif @@ -1666,9 +1822,9 @@ typedef I32 CHECKPOINT; #define U_I(what) ((unsigned int)(what)) #define U_L(what) ((U32)(what)) #else -#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))) +#define U_S(what) ((U16)cast_ulong((NV)(what))) +#define U_I(what) ((unsigned int)cast_ulong((NV)(what))) +#define U_L(what) (cast_ulong((NV)(what))) #endif #ifdef CASTI32 @@ -1676,9 +1832,34 @@ typedef I32 CHECKPOINT; #define I_V(what) ((IV)(what)) #define U_V(what) ((UV)(what)) #else -#define I_32(what) (cast_i32((double)(what))) -#define I_V(what) (cast_iv((double)(what))) -#define U_V(what) (cast_uv((double)(what))) +#define I_32(what) (cast_i32((NV)(what))) +#define I_V(what) (cast_iv((NV)(what))) +#define U_V(what) (cast_uv((NV)(what))) +#endif + +/* These do not care about the fractional part, only about the range. */ +#define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX) +#define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX) + +/* The correct way: a Configure test where (UV)~0 is cast to NV and back. */ +/* Believe. */ +#define IV_FITS_IN_NV +/* Doubt. */ +#if defined(USE_LONG_DOUBLE) && \ + defined(LDBL_MANT_DIG) && IV_DIG >= LDBL_MANT_DIG +# undef IV_FITS_IN_NV +#else +# if defined(DBL_MANT_DIG) && IV_DIG >= DBL_MANT_DIG +# undef IV_FITS_IN_NV +# else +# if IV_DIG >= NV_DIG +# undef IV_FITS_IN_NV +# else +# if IVSIZE >= NVSIZE +# undef IV_FITS_IN_NV +# endif +# endif +# endif #endif /* Used with UV/IV arguments: */ @@ -1686,20 +1867,10 @@ typedef I32 CHECKPOINT; #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; - U32 o_len; -}; - #ifndef MAXSYSFD # define MAXSYSFD 2 #endif -#ifndef TMPPATH -# define TMPPATH "/tmp/perl-eXXXXXX" -#endif - #ifndef __cplusplus Uid_t getuid (void); Uid_t geteuid (void); @@ -1708,7 +1879,13 @@ Gid_t getegid (void); #endif #ifndef Perl_debug_log -#define Perl_debug_log PerlIO_stderr() +# define Perl_debug_log PerlIO_stderr() +#endif + +#ifndef Perl_error_log +# define Perl_error_log (PL_stderrgv \ + ? IoOFP(GvIOp(PL_stderrgv)) \ + : PerlIO_stderr()) #endif #ifdef DEBUGGING @@ -1723,10 +1900,13 @@ 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 -# ifdef PERL_OBJECT +# 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 +# define DEBUG_m(a) \ + STMT_START { \ + if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) { a; } } \ + } STMT_END # endif #define DEBUG_f(a) if (PL_debug & 256) a #define DEBUG_r(a) if (PL_debug & 512) a @@ -1767,9 +1947,9 @@ 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 @@ -1782,8 +1962,10 @@ struct ufuncs { /* Fix these up for __STDC__ */ #ifndef DONT_DECLARE_STD char *mktemp (char*); +#ifndef atof double atof (const char*); #endif +#endif #ifndef STANDARD_C /* All of these are in stdlib.h or time.h for ANSI C */ @@ -1829,7 +2011,9 @@ char *crypt (const char*, const char*); # ifndef getenv char *getenv (const char*); # endif /* !getenv */ +#ifndef EPOC Off_t lseek (int,Off_t,int); +#endif # endif /* !DONT_DECLARE_STD */ char *getlogin (void); #endif /* !__cplusplus */ @@ -1854,7 +2038,7 @@ I32 unlnk (char*); # endif #endif -typedef Signal_t (*Sighandler_t) (int); +/* Sighandler_t defined in iperlsys.h */ #ifdef HAS_SIGACTION typedef struct sigaction Sigsave_t; @@ -1871,10 +2055,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 @@ -1900,18 +2084,8 @@ typedef Sighandler_t Sigsave_t; #endif -/* - * These need prototyping here because isn't - * included until after runops is initialised. - */ - -#ifndef PERL_OBJECT -typedef int (*runops_proc_t) (void); -int runops_standard (void); -#ifdef DEBUGGING -int runops_debug (void); -#endif -#endif +typedef int (CPERLscope(*runops_proc_t)) (pTHX); +typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX); /* _ (for $_) must be first in the following list (DEFSV requires it) */ #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" @@ -1935,12 +2109,14 @@ EXT char *** environ_pointer; # if !defined(DONT_DECLARE_STD) || \ (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \ defined(__sgi) || \ - defined(__DGUX) + defined(__DGUX) || defined(EPOC) extern char ** environ; /* environment variables supplied via exec */ # endif # endif #endif +START_EXTERN_C + /* handy constants */ EXTCONST char PL_warn_uninit[] INIT("Use of uninitialized value"); @@ -2199,6 +2375,8 @@ EXTCONST char* PL_block_type[]; #endif #endif +END_EXTERN_C + /*****************************************************************************/ /* This lexer/parser stuff is currently global since yacc is hard to reenter */ /*****************************************************************************/ @@ -2214,6 +2392,8 @@ typedef enum { XREF, XSTATE, XBLOCK, + XATTRBLOCK, + XATTRTERM, XTERMBLOCK } expectation; @@ -2254,6 +2434,7 @@ enum { /* pass one of these to get_vtbl */ /* 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_notused4 0x00000004 */ @@ -2280,46 +2461,50 @@ enum { /* pass one of these to get_vtbl */ /* Various states of an input record separator SV (rs, nrs) */ #define RsSNARF(sv) (! SvOK(sv)) -#define RsSIMPLE(sv) (SvOK(sv) && SvCUR(sv)) -#define RsPARA(sv) (SvOK(sv) && ! SvCUR(sv)) +#define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv))) +#define RsPARA(sv) (SvPOK(sv) && ! SvCUR(sv)) #define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0)) /* 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); -#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*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm); +typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg, + char* strend, char* strbeg, I32 minend, + SV* screamer, void* data, U32 flags); +typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv, + char *strpos, char *strend, + U32 flags, + struct re_scream_pos_data_s *d); +typedef SV* (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog); +typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r); +#ifdef USE_PURE_BISON +int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp); #endif +typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*); +typedef void (*DESTRUCTORFUNC_t) (pTHXo_ void*); +typedef void (*SVFUNC_t) (pTHXo_ SV*); +typedef I32 (*SVCOMPARE_t) (pTHXo_ SV*, SV*); +typedef void (*XSINIT_t) (pTHXo); +typedef void (*ATEXIT_t) (pTHXo_ void*); +typedef void (*XSUBADDR_t) (pTHXo_ CV *); + /* Set up PERLVAR macros for populating structs */ #define PERLVAR(var,type) type var; +#define PERLVARA(var,n,type) type var[n]; #define PERLVARI(var,type,init) type var; #define PERLVARIC(var,type,init) type var; /* Interpreter exitlist entry */ typedef struct exitlistentry { -#ifdef PERL_OBJECT - void (*fn) (CPerlObj*, void*); -#else - void (*fn) (void*); -#endif + void (*fn) (pTHXo_ void*); void *ptr; } PerlExitListEntry; #ifdef PERL_OBJECT -extern "C" CPerlObj* perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); - -#ifdef PERL_OBJECT -typedef int (CPerlObj::*runops_proc_t) (void); -#endif /* PERL_OBJECT */ +#undef perl_alloc +#define perl_alloc Perl_alloc +CPerlObj* Perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); #undef EXT #define EXT @@ -2333,6 +2518,7 @@ public: CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); void Init(void); void* operator new(size_t nSize, IPerlMem *pvtbl); + static void operator delete(void* pPerl, IPerlMem *pvtbl); #endif /* PERL_OBJECT */ #ifdef PERL_GLOBAL_STRUCT @@ -2344,11 +2530,11 @@ 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) || defined(CYGWIN32)) +#if !defined(__GNUC__) || !defined(WIN32) EXT #endif /* WIN32 */ struct perl_vars *PL_VarsPtr; -#define PL_Vars (*((PL_VarsPtr) ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars()))) +#define PL_Vars (*((PL_VarsPtr) ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX)))) #endif /* PERL_CORE */ #endif /* PERL_GLOBAL_STRUCT */ @@ -2360,7 +2546,9 @@ struct perl_vars *PL_VarsPtr; */ struct interpreter { -#include "thrdvar.h" +#ifndef USE_THREADS +# include "thrdvar.h" +#endif #include "intrpvar.h" }; @@ -2388,6 +2576,7 @@ typedef void *Thread; /* Done with PERLVAR macros for now ... */ #undef PERLVAR +#undef PERLVARA #undef PERLVARI #undef PERLVARIC @@ -2398,13 +2587,6 @@ typedef void *Thread; # 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 */ @@ -2414,23 +2596,31 @@ START_EXTERN_C # endif #endif -#ifdef USE_PURE_BISON -int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp); +#ifdef PERL_OBJECT +#define PERL_DECL_PROT +#define perl_alloc Perl_alloc #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" +#undef PERL_CKDEF +#undef PERL_PPDEF +#define PERL_CKDEF(s) OP *s (pTHX_ OP *o); +#define PERL_PPDEF(s) OP *s (pTHX); +#ifdef PERL_OBJECT +public: +#endif + #include "pp_proto.h" +#ifdef PERL_OBJECT +int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp); +#undef PERL_DECL_PROT +#endif + #ifndef PERL_OBJECT -END_EXTERN_C +/* this has structure inits, so it cannot be included before here */ +# include "opcode.h" #endif /* The following must follow proto.h as #defines mess up syntax */ @@ -2445,13 +2635,10 @@ END_EXTERN_C */ #define PERLVAR(var,type) EXT type PL_##var; +#define PERLVARA(var,n,type) EXT type PL_##var[n]; #define PERLVARI(var,type,init) EXT type PL_##var INIT(init); #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init); -#ifndef PERL_GLOBAL_STRUCT -#include "perlvars.h" -#endif - #ifndef MULTIPLICITY # include "intrpvar.h" @@ -2467,9 +2654,10 @@ END_EXTERN_C * be defined to maintain binary compatibility with PERL_OBJECT * for 5.005 */ -PERLVAR(object_compatibility[30], char) +PERLVARA(object_compatibility,30, char) }; + # include "embed.h" # if defined(WIN32) && !defined(WIN32IO_IS_STDIO) # define errno CPerlObj::ErrorNo() @@ -2484,105 +2672,108 @@ PERLVAR(object_compatibility[30], char) /* this has structure inits, so it cannot be included before here */ # include "opcode.h" +#else +# if defined(WIN32) +# include "embed.h" +# endif #endif /* PERL_OBJECT */ +#ifndef PERL_GLOBAL_STRUCT +START_EXTERN_C + +# include "perlvars.h" + +END_EXTERN_C +#endif + #undef PERLVAR +#undef PERLVARA #undef PERLVARI #undef PERLVARIC -#if defined(HASATTRIBUTE) && defined(WIN32) && !defined(CYGWIN32) -/* - * 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 */ +START_EXTERN_C #ifdef DOINIT -EXT MGVTBL PL_vtbl_sv = {magic_get, - magic_set, - magic_len, +EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get), + MEMBER_TO_FPTR(Perl_magic_set), + MEMBER_TO_FPTR(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, MEMBER_TO_FPTR(Perl_magic_set_all_env), + 0, MEMBER_TO_FPTR(Perl_magic_clear_all_env), 0}; -EXT MGVTBL PL_vtbl_envelem = {0, magic_setenv, - 0, magic_clearenv, +EXT MGVTBL PL_vtbl_envelem = {0, MEMBER_TO_FPTR(Perl_magic_setenv), + 0, MEMBER_TO_FPTR(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 = {MEMBER_TO_FPTR(Perl_magic_getsig), + MEMBER_TO_FPTR(Perl_magic_setsig), + 0, MEMBER_TO_FPTR(Perl_magic_clearsig), 0}; -EXT MGVTBL PL_vtbl_pack = {0, 0, magic_sizepack, magic_wipepack, +EXT MGVTBL PL_vtbl_pack = {0, 0, MEMBER_TO_FPTR(Perl_magic_sizepack), MEMBER_TO_FPTR(Perl_magic_wipepack), 0}; -EXT MGVTBL PL_vtbl_packelem = {magic_getpack, - magic_setpack, - 0, magic_clearpack, +EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack), + MEMBER_TO_FPTR(Perl_magic_setpack), + 0, MEMBER_TO_FPTR(Perl_magic_clearpack), 0}; -EXT MGVTBL PL_vtbl_dbline = {0, magic_setdbline, +EXT MGVTBL PL_vtbl_dbline = {0, MEMBER_TO_FPTR(Perl_magic_setdbline), 0, 0, 0}; -EXT MGVTBL PL_vtbl_isa = {0, magic_setisa, - 0, magic_setisa, +EXT MGVTBL PL_vtbl_isa = {0, MEMBER_TO_FPTR(Perl_magic_setisa), + 0, MEMBER_TO_FPTR(Perl_magic_setisa), 0}; -EXT MGVTBL PL_vtbl_isaelem = {0, magic_setisa, +EXT MGVTBL PL_vtbl_isaelem = {0, MEMBER_TO_FPTR(Perl_magic_setisa), 0, 0, 0}; -EXT MGVTBL PL_vtbl_arylen = {magic_getarylen, - magic_setarylen, +EXT MGVTBL PL_vtbl_arylen = {MEMBER_TO_FPTR(Perl_magic_getarylen), + MEMBER_TO_FPTR(Perl_magic_setarylen), 0, 0, 0}; -EXT MGVTBL PL_vtbl_glob = {magic_getglob, - magic_setglob, +EXT MGVTBL PL_vtbl_glob = {MEMBER_TO_FPTR(Perl_magic_getglob), + MEMBER_TO_FPTR(Perl_magic_setglob), 0, 0, 0}; -EXT MGVTBL PL_vtbl_mglob = {0, magic_setmglob, +EXT MGVTBL PL_vtbl_mglob = {0, MEMBER_TO_FPTR(Perl_magic_setmglob), 0, 0, 0}; -EXT MGVTBL PL_vtbl_nkeys = {magic_getnkeys, - magic_setnkeys, +EXT MGVTBL PL_vtbl_nkeys = {MEMBER_TO_FPTR(Perl_magic_getnkeys), + MEMBER_TO_FPTR(Perl_magic_setnkeys), 0, 0, 0}; -EXT MGVTBL PL_vtbl_taint = {magic_gettaint,magic_settaint, +EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint),MEMBER_TO_FPTR(Perl_magic_settaint), 0, 0, 0}; -EXT MGVTBL PL_vtbl_substr = {magic_getsubstr, magic_setsubstr, +EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr), MEMBER_TO_FPTR(Perl_magic_setsubstr), 0, 0, 0}; -EXT MGVTBL PL_vtbl_vec = {magic_getvec, - magic_setvec, +EXT MGVTBL PL_vtbl_vec = {MEMBER_TO_FPTR(Perl_magic_getvec), + MEMBER_TO_FPTR(Perl_magic_setvec), 0, 0, 0}; -EXT MGVTBL PL_vtbl_pos = {magic_getpos, - magic_setpos, +EXT MGVTBL PL_vtbl_pos = {MEMBER_TO_FPTR(Perl_magic_getpos), + MEMBER_TO_FPTR(Perl_magic_setpos), 0, 0, 0}; -EXT MGVTBL PL_vtbl_bm = {0, magic_setbm, +EXT MGVTBL PL_vtbl_bm = {0, MEMBER_TO_FPTR(Perl_magic_setbm), 0, 0, 0}; -EXT MGVTBL PL_vtbl_fm = {0, magic_setfm, +EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm), 0, 0, 0}; -EXT MGVTBL PL_vtbl_uvar = {magic_getuvar, - magic_setuvar, +EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar), + MEMBER_TO_FPTR(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, MEMBER_TO_FPTR(Perl_magic_mutexfree)}; #endif /* USE_THREADS */ -EXT MGVTBL PL_vtbl_defelem = {magic_getdefelem,magic_setdefelem, +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, 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, 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), 0, 0, 0, 0}; #ifdef USE_LOCALE_COLLATE EXT MGVTBL PL_vtbl_collxfrm = {0, - magic_setcollxfrm, + MEMBER_TO_FPTR(Perl_magic_setcollxfrm), 0, 0, 0}; #endif -EXT MGVTBL PL_vtbl_amagic = {0, magic_setamagic, - 0, 0, magic_setamagic}; -EXT MGVTBL PL_vtbl_amagicelem = {0, magic_setamagic, - 0, 0, magic_setamagic}; +EXT MGVTBL PL_vtbl_amagic = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), + 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; +EXT MGVTBL PL_vtbl_amagicelem = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), + 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; EXT MGVTBL PL_vtbl_backref = {0, 0, - 0, 0, magic_killbackrefs}; + 0, 0, MEMBER_TO_FPTR(Perl_magic_killbackrefs)}; #else /* !DOINIT */ @@ -2706,6 +2897,8 @@ EXTCONST char * PL_AMG_names[NofAMmeth] = { EXTCONST char * PL_AMG_names[NofAMmeth]; #endif /* def INITAMAGIC */ +END_EXTERN_C + struct am_table { long was_ok_sub; long was_ok_am; @@ -2797,13 +2990,37 @@ typedef struct am_table_short AMTS; set_numeric_local(); \ } STMT_END +#define IS_NUMERIC_RADIX(c) \ + ((PL_hints & HINT_LOCALE) && \ + PL_numeric_radix && (c) == PL_numeric_radix) + +#define RESTORE_NUMERIC_LOCAL() if ((PL_hints & HINT_LOCALE) && PL_numeric_standard) SET_NUMERIC_LOCAL() +#define RESTORE_NUMERIC_STANDARD() if ((PL_hints & HINT_LOCALE) && PL_numeric_local) SET_NUMERIC_STANDARD() +#define Atof my_atof + #else /* !USE_LOCALE_NUMERIC */ -#define SET_NUMERIC_STANDARD() /**/ -#define SET_NUMERIC_LOCAL() /**/ +#define SET_NUMERIC_STANDARD() /**/ +#define SET_NUMERIC_LOCAL() /**/ +#define IS_NUMERIC_RADIX(c) (0) +#define RESTORE_NUMERIC_LOCAL() /**/ +#define RESTORE_NUMERIC_STANDARD() /**/ +#define Atof Perl_atof #endif /* !USE_LOCALE_NUMERIC */ +#if defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) && defined(HAS_ATOLL) +#define Atol atoll +#else +#define Atol atol +#endif + +#if defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) && defined(HAS_STRTOULL) +#define Strtoul strtoull +#else +#define Strtoul strtoul +#endif + #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE) /* * Now we have __attribute__ out of the way @@ -2837,12 +3054,21 @@ typedef struct am_table_short AMTS; # include # ifndef HAS_UNION_SEMUN /* Provide the union semun. */ union semun { - int val; - struct semid_ds *buf; - unsigned short *array; + int val; + struct semid_ds *buf; + unsigned short *array; }; # endif # ifdef USE_SEMCTL_SEMUN +# ifdef IRIX32_SEMUN_BROKEN_BY_GCC + union gccbug_semun { + int val; + struct semid_ds *buf; + unsigned short *array; + char __dummy[5]; + }; +# define semun gccbug_semun +# endif # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) # else # ifdef USE_SEMCTL_SEMID_DS @@ -2851,20 +3077,6 @@ typedef struct am_table_short AMTS; # 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 @@ -2876,6 +3088,28 @@ typedef struct am_table_short AMTS; #ifdef I_MNTENT # include /* for getmntent() */ #endif +#ifdef I_SYS_STATFS +# include /* for some statfs() */ +#endif +#ifdef I_SYS_VFS +# include /* for some statfs() */ +#endif +#ifdef I_USTAT +# include /* for ustat() */ +#endif + +#if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID) +# define PERL_MOUNT_NOSUID MOUNT_NOSUID +#endif +#if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID) +# define PERL_MOUNT_NOSUID MNT_NOSUID +#endif +#if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID) +# define PERL_MOUNT_NOSUID MS_NOSUID +#endif +#if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID) +# define PERL_MOUNT_NOSUID M_NOSUID +#endif #endif /* IAMSUID */