X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=60a41ea5ed90680ea793a8aeae6bed4d39c9e359;hb=c9fdb9e966a1ba8953c235de2e289c17cdd8c75f;hp=cd46b7d471d601632dea0d0bdd79e35e6ac43aac;hpb=864dbfa3ca8032ef66f7aa86961933b19b962357;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index cd46b7d..60a41ea 100644 --- a/perl.h +++ b/perl.h @@ -9,6 +9,8 @@ #ifndef H_PERL #define H_PERL 1 +/*#define PERL_IMPLICIT_CONTEXT*/ + #ifdef PERL_FOR_X2P /* * This file is being used for x2p stuff. @@ -133,8 +135,9 @@ class CPerlObj; #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 @@ -147,7 +150,7 @@ class CPerlObj; #else # define START_EXTERN_C # define END_EXTERN_C -# define EXTERN_C +# define EXTERN_C extern #endif #ifdef OP_IN_REGISTER @@ -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 /* @@ -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,6 +380,10 @@ 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 @@ -1299,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 @@ -1492,24 +1487,6 @@ typedef pthread_key_t perl_key; # endif #endif -#ifdef UNION_ANY_DEFINITION -UNION_ANY_DEFINITION; -#else -union any { - void* any_ptr; - I32 any_i32; - IV any_iv; - long any_long; - void (CPERLscope(*any_dptr)) (void*); -}; -#endif - -#ifdef USE_THREADS -#define ARGSproto struct perl_thread *thr -#else -#define ARGSproto void -#endif /* USE_THREADS */ - #if defined(CYGWIN32) /* USEMYBINMODE * This symbol, if defined, indicates that the program should @@ -1522,22 +1499,77 @@ union any { (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : NULL) #endif +#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 void # define pTHX_ # define _pTHX -#endif - -#ifndef aTHX # 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 +union any { + void* any_ptr; + I32 any_i32; + IV any_iv; + long any_long; + void (CPERLscope(*any_dptr)) (pTHX_ void*); +}; +#endif + +#ifdef USE_THREADS +#define ARGSproto struct perl_thread *thr +#else +#define ARGSproto +#endif /* USE_THREADS */ + +#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" @@ -1723,7 +1755,7 @@ 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 @@ -1767,9 +1799,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 @@ -1871,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 @@ -1900,17 +1932,10 @@ 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 +#ifdef PERL_OBJECT +typedef int (CPerlObj::*runops_proc_t) (void); +#else +typedef int (*runops_proc_t) (pTHX); #endif /* _ (for $_) must be first in the following list (DEFSV requires it) */ @@ -1941,6 +1966,8 @@ extern char ** environ; /* environment variables supplied via exec */ # endif #endif +START_EXTERN_C + /* handy constants */ EXTCONST char PL_warn_uninit[] INIT("Use of uninitialized value"); @@ -2199,6 +2226,8 @@ EXTCONST char* PL_block_type[]; #endif #endif +END_EXTERN_C + /*****************************************************************************/ /* This lexer/parser stuff is currently global since yacc is hard to reenter */ /*****************************************************************************/ @@ -2254,6 +2283,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 */ @@ -2292,8 +2322,8 @@ typedef I32 (CPerlObj::*regexec_t) (regexp* prog, char* stringarg, 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* +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); @@ -2309,7 +2339,7 @@ typedef struct exitlistentry { #ifdef PERL_OBJECT void (*fn) (CPerlObj*, void*); #else - void (*fn) (void*); + void (*fn) (pTHX_ void*); #endif void *ptr; } PerlExitListEntry; @@ -2317,10 +2347,6 @@ typedef struct exitlistentry { #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 EXT #define EXT #undef EXTCONST @@ -2449,7 +2475,9 @@ END_EXTERN_C #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init); #ifndef PERL_GLOBAL_STRUCT +START_EXTERN_C #include "perlvars.h" +END_EXTERN_C #endif #ifndef MULTIPLICITY @@ -2490,99 +2518,89 @@ PERLVAR(object_compatibility[30], char) #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 = {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 -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, 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, magic_killbackrefs}; + 0, 0, Perl_magic_killbackrefs}; #else /* !DOINIT */ @@ -2706,6 +2724,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;