X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=60f7dd56050026b4549d6a14fbb213eda7f2abcb;hb=0c815be9f490bd7db5177b102e9ec25d74b97f4f;hp=cd0f2bb11cc7858fa67da9473abfe82122b3e1a3;hpb=09b7f37c58c6da6f4965b846b64eab7d9a205663;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index cd0f2bb..60f7dd5 100644 --- a/perl.h +++ b/perl.h @@ -24,6 +24,111 @@ #define USE_STDIO #endif /* PERL_FOR_X2P */ +#ifdef PERL_OBJECT + +/* PERL_OBJECT explained - DickH and DougL @ ActiveState.com + +Defining PERL_OBJECT turns on creation of a C++ object that +contains all writable core perl global variables and functions. +Stated another way, all necessary global variables and functions +are members of a big C++ object. This object's class is CPerlObj. +This allows a Perl Host to have multiple, independent perl +interpreters in the same process space. This is very important on +Win32 systems as the overhead of process creation is quite high -- +this could be even higher than the script compile and execute time +for small scripts. + +The perl executable implementation on Win32 is composed of perl.exe +(the Perl Host) and perlX.dll. (the Perl Core). This allows the +same Perl Core to easily be embedded in other applications that use +the perl interpreter. + ++-----------+ +| Perl Host | ++-----------+ + ^ + | + v ++-----------+ +-----------+ +| Perl Core |<->| Extension | ++-----------+ +-----------+ ... + +Defining PERL_OBJECT has the following effects: + +PERL CORE +1. CPerlObj is defined (this is the PERL_OBJECT) +2. all static functions that needed to access either global +variables or functions needed are made member functions +3. all writable static variables are made member variables +4. all global variables and functions are defined as: + #define var CPerlObj::Perl_var + #define func CPerlObj::Perl_func + * these are in objpp.h +This necessitated renaming some local variables and functions that +had the same name as a global variable or function. This was +probably a _good_ thing anyway. + + +EXTENSIONS +1. Access to global variables and perl functions is through a +pointer to the PERL_OBJECT. This pointer type is CPerlObj*. This is +made transparent to extension developers by the following macros: + #define var pPerl->Perl_var + #define func pPerl->Perl_func + * these are done in ObjXSub.h +This requires that the extension be compiled as C++, which means +that the code must be ANSI C and not K&R C. For K&R extensions, +please see the C API notes located in Win32/GenCAPI.pl. This script +creates a PerlCAPI.lib that provides a K & R compatible C interface +to the PERL_OBJECT. +2. Local variables and functions cannot have the same name as perl's +variables or functions since the macros will redefine these. Look for +this if you get some strange error message and it does not look like +the code that you had written. This often happens with variables that +are local to a function. + +PERL HOST +1. The perl host is linked with perlX.lib to get perl_alloc. This +function will return a pointer to CPerlObj (the PERL_OBJECT). It +takes pointers to the various PerlXXX_YYY interfaces (see ipdir.h for +information on this). +2. The perl host calls the same functions as normally would be +called in setting up and running a perl script, except that the +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 CALLRUNOPS (this->*runops) + +#else /* !PERL_OBJECT */ + +#define STATIC static +#define CPERLscope(x) x +#define CPERLproto +#define _CPERLproto +#define CPERLarg void +#define CPERLarg_ +#define _CPERLarg +#define PERL_OBJECT_THIS +#define _PERL_OBJECT_THIS +#define PERL_OBJECT_THIS_ +#define CALLRUNOPS runops + +#endif /* PERL_OBJECT */ + #define VOIDUSED 1 #include "config.h" @@ -91,7 +196,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #define SOFT_CAST(type) (type) #endif -#ifndef BYTEORDER +#ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */ # define BYTEORDER 0x1234 #endif @@ -208,6 +313,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #endif #include "perlio.h" +#include "perlmem.h" #include "perllio.h" #include "perlsock.h" #include "perlproc.h" @@ -695,12 +801,21 @@ Free_t Perl_free _((Malloc_t where)); # ifdef convex # define Quad_t long long # else -# if BYTEORDER > 0xFFFF +# if LONGSIZE == 8 # define Quad_t long # endif # endif #endif +/* XXX Experimental set-up for long long. Just add -DUSE_LONG_LONG + to your ccflags. --Andy Dougherty 4/1998 +*/ +#ifdef USE_LONG_LONG +# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8 +# define Quad_t long long +# endif +#endif + #ifdef Quad_t # define HAS_QUAD typedef Quad_t IV; @@ -962,7 +1077,12 @@ typedef union any ANY; #include "handy.h" +#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(rsfp_filters)[idx]) #define FILTER_ISREADER(idx) (idx >= AvFILLp(rsfp_filters)) @@ -985,6 +1105,10 @@ 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 @@ -1088,7 +1212,11 @@ union any { I32 any_i32; IV any_iv; long any_long; - void (*any_dptr) _((void*)); + void (CPERLscope(*any_dptr)) _((void*)); +#if defined(WIN32) && !defined(PERL_OBJECT) + /* Visual C thinks that a pointer to a member variable is 16 bytes in size. */ + char handle_VC_problem[16]; +#endif }; #ifdef USE_THREADS @@ -1118,6 +1246,55 @@ union any { #include "bytecode.h" #include "byterun.h" +/* Current curly descriptor */ +typedef struct curcur CURCUR; +struct curcur { + int parenfloor; /* how far back to strip paren data */ + int cur; /* how many instances of scan we've matched */ + int min; /* the minimal number of scans to match */ + int max; /* the maximal number of scans to match */ + int minmod; /* whether to work our way up or down */ + regnode * scan; /* the thing to match */ + regnode * next; /* what has to match after it */ + char * lastloc; /* where we started matching this scan */ + CURCUR * oldcc; /* current curly before we started this one */ +}; + +typedef struct _sublex_info SUBLEXINFO; +struct _sublex_info { + I32 super_state; /* lexer state to save */ + I32 sub_inwhat; /* "lex_inwhat" to use */ + OP *sub_op; /* "lex_op" to use */ +}; + +#ifdef PERL_OBJECT +struct magic_state { + SV* mgs_sv; + U32 mgs_flags; +}; +typedef struct magic_state MGS; + +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; + +typedef I32 CHECKPOINT; +#endif /* PERL_OBJECT */ + /* work around some libPW problems */ #ifdef DOINIT EXT char Error[1]; @@ -1395,11 +1572,13 @@ typedef Sighandler_t Sigsave_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 /* PERL_OBJECT */ /* _ (for $_) must be first in the following list (DEFSV requires it) */ #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" @@ -1639,12 +1818,41 @@ typedef enum { #define RsSNARF(sv) (! SvOK(sv)) #define RsSIMPLE(sv) (SvOK(sv) && SvCUR(sv)) #define RsPARA(sv) (SvOK(sv) && ! SvCUR(sv)) +#define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0)) /* Set up PERLVAR macros for populating structs */ #define PERLVAR(var,type) type var; #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 *ptr; +} PerlExitListEntry; + +#ifdef PERL_OBJECT +extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*)); + +typedef int (CPerlObj::*runops_proc_t) _((void)); +#undef EXT +#define EXT +#undef EXTCONST +#define EXTCONST +#undef INIT +#define INIT(x) + +class CPerlObj { +public: + CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); + void Init(void); + void* operator new(size_t nSize, IPerlMem *pvtbl); +#endif /* PERL_OBJECT */ + #ifdef PERL_GLOBAL_STRUCT struct perl_vars { #include "perlvars.h" @@ -1741,6 +1949,17 @@ typedef void *Thread; #include "intrpvar.h" #endif +#ifdef PERL_OBJECT +}; + +#include "objpp.h" +#ifdef DOINIT +#include "INTERN.h" +#else +#include "EXTERN.h" +#endif +#endif /* PERL_OBJECT */ + #undef PERLVAR #undef PERLVARI @@ -1753,7 +1972,9 @@ typedef void *Thread; * 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 @@ -1794,13 +2015,15 @@ EXT MGVTBL vtbl_glob = {magic_getglob, 0, 0, 0}; EXT MGVTBL vtbl_mglob = {0, magic_setmglob, 0, 0, 0}; -EXT MGVTBL vtbl_nkeys = {0, magic_setnkeys, +EXT MGVTBL vtbl_nkeys = {magic_getnkeys, + magic_setnkeys, 0, 0, 0}; EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint, 0, 0, 0}; -EXT MGVTBL vtbl_substr = {0, magic_setsubstr, +EXT MGVTBL vtbl_substr = {magic_getsubstr, magic_setsubstr, 0, 0, 0}; -EXT MGVTBL vtbl_vec = {0, magic_setvec, +EXT MGVTBL vtbl_vec = {magic_getvec, + magic_setvec, 0, 0, 0}; EXT MGVTBL vtbl_pos = {magic_getpos, magic_setpos, @@ -1818,7 +2041,7 @@ EXT MGVTBL vtbl_mutex = {0, 0, 0, 0, magic_mutexfree}; EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem, 0, 0, magic_freedefelem}; -EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp}; +EXT MGVTBL vtbl_regexp = {0,magic_unchain,0,0, magic_freeregexp}; #ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm = {0, @@ -1946,7 +2169,7 @@ enum { subtr_amg, subtr_ass_amg, mult_amg, mult_ass_amg, div_amg, div_ass_amg, - mod_amg, mod_ass_amg, + modulo_amg, modulo_ass_amg, pow_amg, pow_ass_amg, lshift_amg, lshift_ass_amg, rshift_amg, rshift_ass_amg, @@ -2003,7 +2226,7 @@ enum { #endif /* OVERLOAD */ -#define PERLDB_ALL 0xff +#define PERLDB_ALL 0x3f /* No _NONAME, _GOTO */ #define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */ #define PERLDBf_LINE 0x02 /* Keep line #. */ #define PERLDBf_NOOPT 0x04 /* Switch off optimizations. */ @@ -2011,6 +2234,8 @@ enum { later inspections. */ #define PERLDBf_SUBLINE 0x10 /* Keep subr source lines. */ #define PERLDBf_SINGLE 0x20 /* Start with single-step on. */ +#define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr. */ +#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto. */ #define PERLDB_SUB (perldb && (perldb & PERLDBf_SUB)) #define PERLDB_LINE (perldb && (perldb & PERLDBf_LINE)) @@ -2018,6 +2243,8 @@ enum { #define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER)) #define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE)) #define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE)) +#define PERLDB_SUB_NN (perldb && (perldb & (PERLDBf_NONAME))) +#define PERLDB_GOTO (perldb && (perldb & PERLDBf_GOTO)) #ifdef USE_LOCALE_NUMERIC @@ -2063,9 +2290,32 @@ enum { nice_chunk = (char*)(chunk); \ nice_chunk_size = (chunk_size); \ } \ + else { \ + Safefree(chunk); \ + } \ UNLOCK_SV_MUTEX; \ } while (0) +#ifdef HAS_SEM +# include +# include +# ifndef HAS_UNION_SEMUN /* Provide the union semun. */ + union semun { + int val; + struct semid_ds *buf; + unsigned short *array; + }; +# endif +# ifdef USE_SEMCTL_SEMUN +# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) +# else +# ifdef USE_SEMCTL_SEMID_DS +# 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 #endif /* Include guard */ -