X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=60f7dd56050026b4549d6a14fbb213eda7f2abcb;hb=0c815be9f490bd7db5177b102e9ec25d74b97f4f;hp=9b521b9d3c0bd913cb336bfd78072a376c48b541;hpb=dfe9444ca7881e716e9e8feaf20b55da491363ca;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 9b521b9..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" @@ -46,7 +151,11 @@ # ifdef __GNUC__ # define stringify_immed(s) #s # define stringify(s) stringify_immed(s) +#ifdef EMBED +register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); +#else register struct op *op asm(stringify(OP_IN_REGISTER)); +#endif # endif #endif @@ -87,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 @@ -113,8 +222,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # 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) # define DONT_DECLARE_STD 1 #endif @@ -205,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" @@ -692,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; @@ -784,7 +902,11 @@ Free_t Perl_free _((Malloc_t where)); # ifdef MAXUSHORT # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) # else -# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) +# ifdef USHRT_MAX +# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) +# else +# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) +# endif # endif #endif @@ -794,7 +916,11 @@ Free_t Perl_free _((Malloc_t where)); # ifdef MAXSHORT /* Often used in */ # define PERL_SHORT_MAX ((short)MAXSHORT) # else -# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) +# ifdef SHRT_MAX +# define PERL_SHORT_MAX ((short)SHRT_MAX) +# else +# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) +# endif # endif #endif @@ -804,7 +930,11 @@ Free_t Perl_free _((Malloc_t where)); # ifdef MINSHORT # define PERL_SHORT_MIN ((short)MINSHORT) # else -# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) +# ifdef SHRT_MIN +# define PERL_SHORT_MIN ((short)SHRT_MIN) +# else +# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) +# endif # endif #endif @@ -947,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)) @@ -970,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 @@ -1073,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 @@ -1100,6 +1243,57 @@ union any { #include "hv.h" #include "mg.h" #include "scope.h" +#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 @@ -1378,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!@" @@ -1622,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" @@ -1724,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 @@ -1736,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 @@ -1777,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, @@ -1801,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, @@ -1929,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, @@ -1986,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. */ @@ -1994,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)) @@ -2001,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 @@ -2024,7 +2268,7 @@ enum { #endif /* !USE_LOCALE_NUMERIC */ -#if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE) +#if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE) /* * Now we have __attribute__ out of the way * Remap printf @@ -2046,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 */ -