X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ce3f0a3cd6f30cb49f01b7811c2891acb7bab15a..46d2b8efbdb8a80b2cd16fb0b25dca2e0cf590b8:/perl.h diff --git a/perl.h b/perl.h index 4edbd0d..e2b34bc 100644 --- a/perl.h +++ b/perl.h @@ -24,6 +24,115 @@ #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 iperlsys.h +for more 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->*PL_runops) +#define CALLREGCOMP (this->*PL_regcompp) +#define CALLREGEXEC (this->*PL_regexecp) + +#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 PL_runops +#define CALLREGCOMP (*PL_regcompp) +#define CALLREGEXEC (*PL_regexecp) + +#endif /* PERL_OBJECT */ + #define VOIDUSED 1 #include "config.h" @@ -46,7 +155,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 +200,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,7 +226,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # define STANDARD_C 1 #endif -#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) +#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) # define DONT_DECLARE_STD 1 #endif @@ -127,11 +240,11 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # define VOL #endif -#define TAINT (tainted = TRUE) -#define TAINT_NOT (tainted = FALSE) -#define TAINT_IF(c) if (c) { tainted = TRUE; } -#define TAINT_ENV() if (tainting) { taint_env(); } -#define TAINT_PROPER(s) if (tainting) { taint_proper(no_security, s); } +#define TAINT (PL_tainted = TRUE) +#define TAINT_NOT (PL_tainted = FALSE) +#define TAINT_IF(c) if (c) { PL_tainted = TRUE; } +#define TAINT_ENV() if (PL_tainting) { taint_env(); } +#define TAINT_PROPER(s) if (PL_tainting) { taint_proper(no_security, s); } /* XXX All process group stuff is handled in pp_sys.c. Should these defines move there? If so, I could simplify this a lot. --AD 9/96. @@ -203,7 +316,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # endif #endif -#include "perlio.h" +#include "iperlsys.h" #ifdef USE_NEXT_CTYPE @@ -264,7 +377,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # ifdef HIDEMYMALLOC # define malloc Mymalloc # define calloc Mycalloc -# define realloc Myremalloc +# define realloc Myrealloc # define free Myfree Malloc_t Mymalloc _((MEM_SIZE nbytes)); Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size)); @@ -275,11 +388,21 @@ Free_t Myfree _((Malloc_t where)); # define malloc Perl_malloc # define calloc Perl_calloc # define realloc Perl_realloc +/* VMS' external symbols are case-insensitive, and there's already a */ +/* perl_free in perl.h */ +#ifdef VMS +# define free Perl_myfree +#else # define free Perl_free +#endif Malloc_t Perl_malloc _((MEM_SIZE nbytes)); Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size)); Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes)); +#ifdef VMS +Free_t Perl_myfree _((Malloc_t where)); +#else Free_t Perl_free _((Malloc_t where)); +#endif # endif # undef safemalloc @@ -394,6 +517,10 @@ Free_t Perl_free _((Malloc_t where)); # include #endif +#ifdef I_ARPA_INET +# include +#endif + #if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO) /* defines SF_APPEND and might define SF_APPEND * (the neo-BSD seem to do this). */ @@ -444,12 +571,6 @@ Free_t Perl_free _((Malloc_t where)); # undef HAS_STRERROR #endif -#ifndef HAS_MKFIFO -# ifndef mkfifo -# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0)) -# endif -#endif /* !HAS_MKFIFO */ - #include #ifdef HAS_SOCKET # ifdef I_NET_ERRNO @@ -470,13 +591,13 @@ Free_t Perl_free _((Malloc_t where)); #ifdef USE_THREADS # define ERRSV (thr->errsv) # define ERRHV (thr->errhv) -# define DEFSV *av_fetch(thr->threadsv, find_threadsv("_"), FALSE) -# define SAVE_DEFSV save_threadsv(find_threadsv("_")) +# define DEFSV THREADSV(0) +# define SAVE_DEFSV save_threadsv(0) #else -# define ERRSV GvSV(errgv) -# define ERRHV GvHV(errgv) -# define DEFSV GvSV(defgv) -# define SAVE_DEFSV SAVESPTR(GvSV(defgv)) +# 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 */ #ifndef errno @@ -686,12 +807,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; @@ -778,7 +908,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 @@ -788,7 +922,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 @@ -798,7 +936,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 @@ -941,10 +1083,15 @@ 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 >= AvFILL(rsfp_filters)) +#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx]) +#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters)) #ifdef DOSISH # if defined(OS2) @@ -959,11 +1106,19 @@ typedef I32 (*filter_t) _((int, SV *, int)); # if defined(PLAN9) # include "./plan9/plan9ish.h" # else -# include "unixish.h" +# if defined(MPE) +# include "mpeix/mpeixish.h" +# else +# include "unixish.h" +# endif # endif # 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 @@ -972,6 +1127,10 @@ typedef I32 (*filter_t) _((int, SV *, int)); */ #ifdef USE_THREADS + /* pending resolution of licensing issues, we avoid the erstwhile + * atomic.h everywhere */ +# define EMULATE_ATOMIC_REFCOUNTS + # ifdef FAKE_THREADS # include "fakethr.h" # else @@ -994,22 +1153,22 @@ typedef pthread_key_t perl_key; #ifdef VMS -# define STATUS_NATIVE statusvalue_vms +# define STATUS_NATIVE PL_statusvalue_vms # define STATUS_NATIVE_EXPORT \ - ((I32)statusvalue_vms == -1 ? 44 : statusvalue_vms) + ((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) # define STATUS_NATIVE_SET(n) \ STMT_START { \ - statusvalue_vms = (n); \ - if ((I32)statusvalue_vms == -1) \ - statusvalue = -1; \ - else if (statusvalue_vms & STS$M_SUCCESS) \ - statusvalue = 0; \ - else if ((statusvalue_vms & STS$M_SEVERITY) == 0) \ - statusvalue = 1 << 8; \ + PL_statusvalue_vms = (n); \ + if ((I32)PL_statusvalue_vms == -1) \ + PL_statusvalue = -1; \ + else if (PL_statusvalue_vms & STS$M_SUCCESS) \ + PL_statusvalue = 0; \ + else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0) \ + PL_statusvalue = 1 << 8; \ else \ - statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8; \ + PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \ } STMT_END -# define STATUS_POSIX statusvalue +# define STATUS_POSIX PL_statusvalue # ifdef VMSISH_STATUS # define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX) # else @@ -1017,29 +1176,29 @@ typedef pthread_key_t perl_key; # endif # define STATUS_POSIX_SET(n) \ STMT_START { \ - statusvalue = (n); \ - if (statusvalue != -1) { \ - statusvalue &= 0xFFFF; \ - statusvalue_vms = statusvalue ? 44 : 1; \ + PL_statusvalue = (n); \ + if (PL_statusvalue != -1) { \ + PL_statusvalue &= 0xFFFF; \ + PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \ } \ - else statusvalue_vms = -1; \ + else PL_statusvalue_vms = -1; \ } STMT_END -# define STATUS_ALL_SUCCESS (statusvalue = 0, statusvalue_vms = 1) -# define STATUS_ALL_FAILURE (statusvalue = 1, statusvalue_vms = 44) +# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1) +# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44) #else # define STATUS_NATIVE STATUS_POSIX # define STATUS_NATIVE_EXPORT STATUS_POSIX # define STATUS_NATIVE_SET STATUS_POSIX_SET -# define STATUS_POSIX statusvalue +# define STATUS_POSIX PL_statusvalue # define STATUS_POSIX_SET(n) \ STMT_START { \ - statusvalue = (n); \ - if (statusvalue != -1) \ - statusvalue &= 0xFFFF; \ + PL_statusvalue = (n); \ + if (PL_statusvalue != -1) \ + PL_statusvalue &= 0xFFFF; \ } STMT_END # define STATUS_CURRENT STATUS_POSIX -# define STATUS_ALL_SUCCESS (statusvalue = 0) -# define STATUS_ALL_FAILURE (statusvalue = 1) +# define STATUS_ALL_SUCCESS (PL_statusvalue = 0) +# define STATUS_ALL_FAILURE (PL_statusvalue = 1) #endif /* Some unistd.h's give a prototype for pause() even though @@ -1062,13 +1221,17 @@ 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 (*any_dptr) _((void*)); + void (CPERLscope(*any_dptr)) _((void*)); }; +#endif #ifdef USE_THREADS #define ARGSproto struct perl_thread *thr @@ -1094,6 +1257,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 @@ -1211,23 +1425,23 @@ Gid_t getegid _((void)); #endif #define YYDEBUG 1 #define DEB(a) a -#define DEBUG(a) if (debug) a -#define DEBUG_p(a) if (debug & 1) a -#define DEBUG_s(a) if (debug & 2) a -#define DEBUG_l(a) if (debug & 4) a -#define DEBUG_t(a) if (debug & 8) a -#define DEBUG_o(a) if (debug & 16) a -#define DEBUG_c(a) if (debug & 32) a -#define DEBUG_P(a) if (debug & 64) a -#define DEBUG_m(a) if (curinterp && debug & 128) a -#define DEBUG_f(a) if (debug & 256) a -#define DEBUG_r(a) if (debug & 512) a -#define DEBUG_x(a) if (debug & 1024) a -#define DEBUG_u(a) if (debug & 2048) a -#define DEBUG_L(a) if (debug & 4096) a -#define DEBUG_H(a) if (debug & 8192) a -#define DEBUG_X(a) if (debug & 16384) a -#define DEBUG_D(a) if (debug & 32768) a +#define DEBUG(a) if (PL_debug) a +#define DEBUG_p(a) if (PL_debug & 1) a +#define DEBUG_s(a) if (PL_debug & 2) a +#define DEBUG_l(a) if (PL_debug & 4) a +#define DEBUG_t(a) if (PL_debug & 8) a +#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 +#define DEBUG_m(a) if (PL_curinterp && PL_debug & 128) a +#define DEBUG_f(a) if (PL_debug & 256) a +#define DEBUG_r(a) if (PL_debug & 512) a +#define DEBUG_x(a) if (PL_debug & 1024) a +#define DEBUG_u(a) if (PL_debug & 2048) a +#define DEBUG_L(a) if (PL_debug & 4096) a +#define DEBUG_H(a) if (PL_debug & 8192) a +#define DEBUG_X(a) if (PL_debug & 16384) a +#define DEBUG_D(a) if (PL_debug & 32768) a #else #define DEB(a) #define DEBUG(a) @@ -1255,7 +1469,7 @@ Gid_t getegid _((void)); if (!(what)) { \ croak("Assertion failed: file \"%s\", line %d", \ __FILE__, __LINE__); \ - exit(1); \ + PerlProc_exit(1); \ }}) #endif @@ -1299,19 +1513,21 @@ END_EXTERN_C #endif #ifndef __cplusplus -#ifdef __NeXT__ /* or whatever catches all NeXTs */ +# ifdef __NeXT__ /* or whatever catches all NeXTs */ char *crypt (); /* Maybe more hosts will need the unprototyped version */ -#else +# else +# if !defined(WIN32) || !defined(HAVE_DES_FCRYPT) char *crypt _((const char*, const char*)); -#endif -#ifndef DONT_DECLARE_STD -#ifndef getenv +# endif /* !WIN32 && !HAVE_CRYPT_SOURCE */ +# endif /* !__NeXT__ */ +# ifndef DONT_DECLARE_STD +# ifndef getenv char *getenv _((const char*)); -#endif +# endif /* !getenv */ Off_t lseek _((int,Off_t,int)); -#endif +# endif /* !DONT_DECLARE_STD */ char *getlogin _((void)); -#endif +#endif /* !__cplusplus */ #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ #define UNLINK unlnk @@ -1352,13 +1568,13 @@ typedef Sighandler_t Sigsave_t; # define PAD_SV(po) pad_sv(po) # define RUNOPS_DEFAULT runops_debug #else -# define PAD_SV(po) curpad[po] +# define PAD_SV(po) PL_curpad[po] # define RUNOPS_DEFAULT runops_standard #endif #ifdef MYMALLOC -# define MALLOC_INIT MUTEX_INIT(&malloc_mutex) -# define MALLOC_TERM MUTEX_DESTROY(&malloc_mutex) +# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex) +# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex) #else # define MALLOC_INIT # define MALLOC_TERM @@ -1370,17 +1586,22 @@ 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!@" /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */ #if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__)) -#if !defined(DONT_DECLARE_STD) || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || defined(__sgi) +#if !defined(DONT_DECLARE_STD) \ + || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) \ + || defined(__sgi) || defined(__DGUX) extern char ** environ; /* environment variables supplied via exec */ #endif #else @@ -1607,31 +1828,85 @@ typedef enum { #define HINT_STRICT_VARS 0x00000400 #define HINT_LOCALE 0x00000800 +#define HINT_NEW_INTEGER 0x00001000 +#define HINT_NEW_FLOAT 0x00002000 +#define HINT_NEW_BINARY 0x00004000 +#define HINT_NEW_STRING 0x00008000 +#define HINT_NEW_RE 0x00010000 +#define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */ + +#define HINT_RE_TAINT 0x00100000 +#define HINT_RE_EVAL 0x00200000 + /* 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 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)); + +#endif /* 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" }; #ifdef PERL_CORE -EXT struct perl_vars Perl_Vars; -EXT struct perl_vars *Perl_VarsPtr INIT(&Perl_Vars); -#else +EXT struct perl_vars PL_Vars; +EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); +#else /* PERL_CORE */ #if !defined(__GNUC__) || !defined(WIN32) EXT -#endif -struct perl_vars *Perl_VarsPtr; -#define Perl_Vars (*((Perl_VarsPtr) ? Perl_VarsPtr : (Perl_VarsPtr = Perl_GetVars()))) -#endif +#endif /* WIN32 */ +struct perl_vars *PL_VarsPtr; +#define PL_Vars (*((PL_VarsPtr) ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars()))) +#endif /* PERL_CORE */ #endif /* PERL_GLOBAL_STRUCT */ #ifdef MULTIPLICITY @@ -1664,6 +1939,10 @@ struct perl_thread { #include "thrdvar.h" }; +typedef struct perl_thread *Thread; + +#else +typedef void *Thread; #endif /* Done with PERLVAR macros for now ... */ @@ -1671,8 +1950,6 @@ struct perl_thread { #undef PERLVARI #undef PERLVARIC -typedef struct perl_thread *Thread; - #include "thread.h" #include "pp.h" #include "proto.h" @@ -1693,10 +1970,10 @@ typedef struct perl_thread *Thread; * If we don't have threads or multiple interpreters * these include variables that would have been their struct-s */ - -#define PERLVAR(var,type) EXT type var; -#define PERLVARI(var,type,init) EXT type var INIT(init); -#define PERLVARIC(var,type,init) EXTCONST type var INIT(init); + +#define PERLVAR(var,type) EXT type PL_##var; +#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" @@ -1704,12 +1981,23 @@ typedef struct perl_thread *Thread; #ifndef MULTIPLICITY -#ifndef USE_THREADS -#include "thrdvar.h" +# include "intrpvar.h" +# ifndef USE_THREADS +# include "thrdvar.h" +# endif + #endif -#include "intrpvar.h" +#ifdef PERL_OBJECT +}; + +#include "objpp.h" +#ifdef DOINIT +#include "INTERN.h" +#else +#include "EXTERN.h" #endif +#endif /* PERL_OBJECT */ #undef PERLVAR @@ -1723,7 +2011,9 @@ typedef struct perl_thread *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 @@ -1743,7 +2033,7 @@ EXT MGVTBL vtbl_sigelem = {magic_getsig, magic_setsig, 0, magic_clearsig, 0}; -EXT MGVTBL vtbl_pack = {0, 0, 0, magic_wipepack, +EXT MGVTBL vtbl_pack = {0, 0, magic_sizepack, magic_wipepack, 0}; EXT MGVTBL vtbl_packelem = {magic_getpack, magic_setpack, @@ -1764,13 +2054,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, @@ -1786,7 +2078,7 @@ EXT MGVTBL vtbl_uvar = {magic_getuvar, EXT MGVTBL vtbl_mutex = {0, 0, 0, 0, magic_mutexfree}; #endif /* USE_THREADS */ EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem, - 0, 0, magic_freedefelem}; + 0, 0, 0}; EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp}; @@ -1916,7 +2208,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, @@ -1973,7 +2265,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. */ @@ -1981,26 +2273,30 @@ 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)) -#define PERLDB_NOOPT (perldb && (perldb & PERLDBf_NOOPT)) -#define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER)) -#define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE)) -#define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE)) +#define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB)) +#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE)) +#define PERLDB_NOOPT (PL_perldb && (PL_perldb & PERLDBf_NOOPT)) +#define PERLDB_INTER (PL_perldb && (PL_perldb & PERLDBf_INTER)) +#define PERLDB_SUBLINE (PL_perldb && (PL_perldb & PERLDBf_SUBLINE)) +#define PERLDB_SINGLE (PL_perldb && (PL_perldb & PERLDBf_SINGLE)) +#define PERLDB_SUB_NN (PL_perldb && (PL_perldb & (PERLDBf_NONAME))) +#define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO)) #ifdef USE_LOCALE_NUMERIC #define SET_NUMERIC_STANDARD() \ STMT_START { \ - if (! numeric_standard) \ + if (! PL_numeric_standard) \ perl_set_numeric_standard(); \ } STMT_END #define SET_NUMERIC_LOCAL() \ STMT_START { \ - if (! numeric_local) \ + if (! PL_numeric_local) \ perl_set_numeric_local(); \ } STMT_END @@ -2011,7 +2307,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 @@ -2028,14 +2324,37 @@ enum { * and queried under the protection of sv_mutex */ #define offer_nice_chunk(chunk, chunk_size) do { \ - MUTEX_LOCK(&sv_mutex); \ - if (!nice_chunk) { \ - nice_chunk = (char*)(chunk); \ - nice_chunk_size = (chunk_size); \ + LOCK_SV_MUTEX; \ + if (!PL_nice_chunk) { \ + PL_nice_chunk = (char*)(chunk); \ + PL_nice_chunk_size = (chunk_size); \ + } \ + else { \ + Safefree(chunk); \ } \ - MUTEX_UNLOCK(&sv_mutex); \ + 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 */ -