X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=b8f9ae6934d5afa4a1543a02544395c9215166fd;hb=8876aa855575c76fe5c85df0966371a59a0bbc8e;hp=f61ff9bda009460dde35f010cfa4cbacc5387791;hpb=0cb9638729211ea71a75ae8756c03ba21553bd53;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index f61ff9b..b8f9ae6 100644 --- a/perl.h +++ b/perl.h @@ -9,8 +9,6 @@ #ifndef H_PERL #define H_PERL 1 -/*#define PERL_IMPLICIT_CONTEXT*/ - #ifdef PERL_FOR_X2P /* * This file is being used for x2p stuff. @@ -27,7 +25,41 @@ /* XXXXXX testing threads via implicit pointer */ #ifdef USE_THREADS -#define PERL_IMPLICIT_CONTEXT +# ifndef PERL_IMPLICIT_CONTEXT +# define PERL_IMPLICIT_CONTEXT +# endif +# ifndef PERL_IMPLICIT_SYS +/*# define PERL_IMPLICIT_SYS*/ /* XXX not done yet */ +# endif +#endif + +/* XXXXXX testing multiplicity via implicit pointer */ +#if defined(MULTIPLICITY) +# ifndef PERL_IMPLICIT_CONTEXT +# define PERL_IMPLICIT_CONTEXT +# endif +# ifndef PERL_IMPLICIT_SYS +/*# define PERL_IMPLICIT_SYS*/ /* XXX not done yet */ +# 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 @@ -108,18 +140,20 @@ functions are now member functions of the PERL_OBJECT. class CPerlObj; #define STATIC -#define CPERLscope(x) CPerlObj::x -#define CALL_FPTR(fptr) (this->*fptr) - -#define pTHXo CPerlObj *pPerl -#define pTHXo_ pTHXo, -#define _pTHXo ,pTHXo -#define aTHXo this -#define aTHXo_ this, -#define _aTHXo ,this +#define CPERLscope(x) CPerlObj::x +#define CALL_FPTR(fptr) (this->*fptr) + +#define pTHXo CPerlObj *pPerl +#define pTHXo_ pTHXo, +#define _pTHXo ,pTHXo +#define aTHXo this +#define aTHXo_ this, +#define _aTHXo ,this #define PERL_OBJECT_THIS aTHXo #define PERL_OBJECT_THIS_ aTHXo_ #define _PERL_OBJECT_THIS _aTHXo +#define dTHXoa(a) pTHXo = (CPerlObj *)a +#define dTHXo dTHXoa(PERL_GET_INTERP) #define pTHXx void #define pTHXx_ @@ -130,6 +164,27 @@ class CPerlObj; #else /* !PERL_OBJECT */ +#ifdef PERL_IMPLICIT_CONTEXT +# ifdef USE_THREADS +struct perl_thread; +# define pTHX register struct perl_thread *thr +# define aTHX thr +# define dTHXa(a) pTHX = (struct perl_thread *)a +# define dTHX dTHXa(THR) +# define dTHR dNOOP +# else +# define MULTIPLICITY +# define pTHX register PerlInterpreter *my_perl +# define aTHX my_perl +# define dTHXa(a) pTHX = (PerlInterpreter *)a +# define dTHX dTHXa(PERL_GET_INTERP) +# endif +# define pTHX_ pTHX, +# define _pTHX ,pTHX +# define aTHX_ aTHX, +# define _aTHX ,aTHX +#endif + #define STATIC static #define CPERLscope(x) x #define CPERLarg void @@ -145,32 +200,14 @@ 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 NOOP (void)0 #define dNOOP extern int Perl___notused -#ifdef PERL_IMPLICIT_CONTEXT -# ifdef USE_THREADS -struct perl_thread; -# define pTHX register 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 register 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_ @@ -189,6 +226,7 @@ struct perl_thread; # define aTHXo aTHX # define aTHXo_ aTHX_ # define _aTHXo _aTHX +# define dTHXo dTHX #endif #ifndef pTHXx @@ -198,6 +236,7 @@ struct perl_thread; # define aTHXx my_perl # define aTHXx_ aTHXx, # define _aTHXx ,aTHXx +# define dTHXx dTHX #endif #undef START_EXTERN_C @@ -281,15 +320,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) # define DONT_DECLARE_STD 1 #endif @@ -445,6 +484,19 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #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. */ @@ -475,19 +527,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 @@ -997,6 +1036,43 @@ Free_t Perl_mfree (Malloc_t where); # endif #endif +#ifdef USE_LONG_DOUBLE +# if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE) +# define LDoub_t long double +# endif +#endif + +#ifdef USE_LONG_DOUBLE +# define HAS_LDOUB + typedef LDoub_t NV; +# 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_atof atof +# define Perl_fmod fmodl +#else + typedef double NV; +# 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_atof atof /* At some point there may be an atolf */ +# define Perl_fmod fmod +#endif + /* Previously these definitions used hardcoded figures. * It is hoped these formula are more portable, although * no data one way or another is presently known to me. @@ -1198,7 +1274,6 @@ 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; @@ -1386,7 +1461,11 @@ typedef union any ANY; # if defined(__VOS__) # include "vosish.h" # else -# include "unixish.h" +# if defined(EPOC) +# include "epocish.h" +# else +# include "unixish.h" +# endif # endif # endif # endif @@ -1415,10 +1494,6 @@ typedef union any ANY; # 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 @@ -1460,7 +1535,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 \ @@ -1510,6 +1589,10 @@ 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. @@ -1521,11 +1604,19 @@ 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 +#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 + /* 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. @@ -1566,7 +1657,7 @@ union any { I32 any_i32; IV any_iv; long any_long; - void (CPERLscope(*any_dptr)) (pTHX_ void*); + void (*any_dptr) (pTHXo_ void*); }; #endif @@ -1576,16 +1667,24 @@ union any { #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 : FALSE) +#endif + typedef I32 (*filter_t) (pTHXo_ int, SV *, int); #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" @@ -1712,9 +1811,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 @@ -1722,9 +1821,9 @@ 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 /* Used with UV/IV arguments: */ @@ -1772,7 +1871,7 @@ Gid_t getegid (void); # 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) if (PERL_GET_INTERP && PL_debug & 128) a # endif #define DEBUG_f(a) if (PL_debug & 256) a #define DEBUG_r(a) if (PL_debug & 512) a @@ -1875,7 +1974,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 */ @@ -1971,7 +2072,7 @@ 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 @@ -2321,8 +2422,8 @@ 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 */ @@ -2330,10 +2431,27 @@ 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_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; @@ -2415,6 +2533,7 @@ typedef void *Thread; /* Done with PERLVAR macros for now ... */ #undef PERLVAR +#undef PERLVARA #undef PERLVARI #undef PERLVARIC @@ -2441,17 +2560,6 @@ typedef void *Thread; # endif #endif -#ifdef USE_PURE_BISON -int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp); -#endif - -typedef void (CPERLscope(*DESTRUCTORFUNC_t)) (pTHX_ void*); -typedef void (CPERLscope(*SVFUNC_t)) (pTHX_ SV*); -typedef I32 (CPERLscope(*SVCOMPARE_t)) (pTHX_ SV*, SV*); -typedef void (*XSINIT_t) (pTHXo); -typedef void (*ATEXIT_t) (pTHXo_ void*); -typedef void (*XSUBADDR_t) (pTHXo_ CV *); - #ifdef PERL_OBJECT #define PERL_DECL_PROT #define perl_alloc Perl_alloc @@ -2470,7 +2578,6 @@ public: #include "pp_proto.h" #ifdef PERL_OBJECT -VIRTUAL int CPerlObj::fprintf (PerlIO *pf, const char *pat, ...); VIRTUAL int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp); #undef PERL_DECL_PROT #else @@ -2494,21 +2601,10 @@ VIRTUAL int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp); */ #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 -# ifndef PERL_OBJECT -START_EXTERN_C -# endif - -# include "perlvars.h" - -# ifndef PERL_OBJECT -END_EXTERN_C -# endif -#endif - #ifndef MULTIPLICITY # include "intrpvar.h" @@ -2524,9 +2620,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() @@ -2543,7 +2640,16 @@ PERLVAR(object_compatibility[30], char) #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 @@ -2852,7 +2958,7 @@ typedef struct am_table_short AMTS; #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(s) Perl_my_atof(s) +#define Atof my_atof #else /* !USE_LOCALE_NUMERIC */ @@ -2861,7 +2967,7 @@ typedef struct am_table_short AMTS; #define IS_NUMERIC_RADIX(c) (0) #define RESTORE_NUMERIC_LOCAL() /**/ #define RESTORE_NUMERIC_STANDARD() /**/ -#define Atof(s) atof(s) +#define Atof Perl_atof #endif /* !USE_LOCALE_NUMERIC */