#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 _CPERLproto ,CPERLproto
#define CPERLarg CPerlObj *pPerl
#define CPERLarg_ CPERLarg,
-#define THIS this
-#define THIS_ this,
-#define CALLRUNOPS (this->*runops)
+#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 _CPERLproto
#define CPERLarg void
#define CPERLarg_
-#define THIS
-#define THIS_
-#define CALLRUNOPS runops
+#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 */
# 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
#define SOFT_CAST(type) (type)
#endif
-#ifndef BYTEORDER
+#ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */
# define BYTEORDER 0x1234
#endif
# define LIBERAL 1
#endif
+#if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90
+#define ASCIIish
+#else
+#undef ASCIIish
+#endif
+
/*
* The following contortions are brought to you on behalf of all the
* standards, semi-standards, de facto standards, not-so-de-facto standards
# 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
# 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.
# endif
#endif
+/* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that
+ pthread.h must be included before all other header files.
+*/
+#if defined(USE_THREADS) && defined(PTHREAD_H_FIRST)
+# include <pthread.h>
+#endif
+
#ifndef _TYPES_ /* If types.h defines this it's easy. */
# ifndef major /* Does everyone's types.h define this? */
# include <sys/types.h>
# endif
#endif
-#include "perlio.h"
-#include "perlmem.h"
-#include "perllio.h"
-#include "perlsock.h"
-#include "perlproc.h"
-#include "perlenv.h"
-#include "perldir.h"
+#include "iperlsys.h"
#ifdef USE_NEXT_CTYPE
# 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));
# 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
# include <netinet/in.h>
#endif
+#ifdef I_ARPA_INET
+# include <arpa/inet.h>
+#endif
+
#if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
/* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
* (the neo-BSD seem to do this). */
# undef HAS_STRERROR
#endif
-#ifndef HAS_MKFIFO
-# ifndef mkfifo
-# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
-# endif
-#endif /* !HAS_MKFIFO */
-
#include <errno.h>
#ifdef HAS_SOCKET
# ifdef I_NET_ERRNO
# 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
# 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;
# 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
# ifdef MAXSHORT /* Often used in <values.h> */
# 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
# 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
#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))
+#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx])
+#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters))
#ifdef DOSISH
# if defined(OS2)
# if defined(PLAN9)
# include "./plan9/plan9ish.h"
# else
-# include "unixish.h"
+# if defined(MPE)
+# include "mpeix/mpeixish.h"
+# else
+# if defined(__VOS__)
+# include "vosish.h"
+# else
+# include "unixish.h"
+# endif
+# 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 <pthread.h> includes
* <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
*/
#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
#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
# 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
# endif
#endif
+#ifdef UNION_ANY_DEFINITION
+UNION_ANY_DEFINITION;
+#else
union any {
void* any_ptr;
I32 any_i32;
long any_long;
void (CPERLscope(*any_dptr)) _((void*));
};
+#endif
#ifdef USE_THREADS
#define ARGSproto struct perl_thread *thr
#include "hv.h"
#include "mg.h"
#include "scope.h"
+#include "warning.h"
+#include "bytecode.h"
+#include "byterun.h"
+#include "utf8.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 {
#ifndef Perl_debug_log
#define Perl_debug_log PerlIO_stderr()
#endif
+#undef YYDEBUG
#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
+# ifdef USE_THREADS
+# define DEBUG_S(a) if (PL_debug & (1<<16)) a
+# else
+# define DEBUG_S(a)
+# endif
#else
#define DEB(a)
#define DEBUG(a)
#define DEBUG_r(a)
#define DEBUG_x(a)
#define DEBUG_u(a)
-#define DEBUG_L(a)
+#define DEBUG_S(a)
#define DEBUG_H(a)
#define DEBUG_X(a)
#define DEBUG_D(a)
+#define DEBUG_S(a)
#endif
#define YYMAXDEPTH 300
/* All of these are in stdlib.h or time.h for ANSI C */
Time_t time();
struct tm *gmtime(), *localtime();
+#ifdef OEMVS
+char *(strchr)(), *(strrchr)();
+char *(strcpy)(), *(strcat)();
+#else
char *strchr(), *strrchr();
char *strcpy(), *strcat();
+#endif
#endif /* ! STANDARD_C */
# 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
/* fast case folding tables */
#ifdef DOINIT
+#ifdef EBCDIC
+EXT unsigned char fold[] = { /* fast EBCDIC case folding table */
+ 0, 1, 2, 3, 4, 5, 6, 7,
+ 8, 9, 10, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 20, 21, 22, 23,
+ 24, 25, 26, 27, 28, 29, 30, 31,
+ 32, 33, 34, 35, 36, 37, 38, 39,
+ 40, 41, 42, 43, 44, 45, 46, 47,
+ 48, 49, 50, 51, 52, 53, 54, 55,
+ 56, 57, 58, 59, 60, 61, 62, 63,
+ 64, 65, 66, 67, 68, 69, 70, 71,
+ 72, 73, 74, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 87,
+ 88, 89, 90, 91, 92, 93, 94, 95,
+ 96, 97, 98, 99, 100, 101, 102, 103,
+ 104, 105, 106, 107, 108, 109, 110, 111,
+ 112, 113, 114, 115, 116, 117, 118, 119,
+ 120, 121, 122, 123, 124, 125, 126, 127,
+ 128, 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 138, 139, 140, 141, 142, 143,
+ 144, 'J', 'K', 'L', 'M', 'N', 'O', 'P',
+ 'Q', 'R', 154, 155, 156, 157, 158, 159,
+ 160, 161, 'S', 'T', 'U', 'V', 'W', 'X',
+ 'Y', 'Z', 170, 171, 172, 173, 174, 175,
+ 176, 177, 178, 179, 180, 181, 182, 183,
+ 184, 185, 186, 187, 188, 189, 190, 191,
+ 192, 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 202, 203, 204, 205, 206, 207,
+ 208, 'j', 'k', 'l', 'm', 'n', 'o', 'p',
+ 'q', 'r', 218, 219, 220, 221, 222, 223,
+ 224, 225, 's', 't', 'u', 'v', 'w', 'x',
+ 'y', 'z', 234, 235, 236, 237, 238, 239,
+ 240, 241, 242, 243, 244, 245, 246, 247,
+ 248, 249, 250, 251, 252, 253, 254, 255
+};
+#else /* ascii rather than ebcdic */
EXTCONST unsigned char fold[] = {
0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 13, 14, 15,
240, 241, 242, 243, 244, 245, 246, 247,
248, 249, 250, 251, 252, 253, 254, 255
};
+#endif /* !EBCDIC */
#else
EXTCONST unsigned char fold[];
#endif
#endif
#ifdef DOINIT
+#ifdef EBCDIC
+EXT unsigned char freq[] = {/* EBCDIC frequencies for mixed English/C */
+ 1, 2, 84, 151, 154, 155, 156, 157,
+ 165, 246, 250, 3, 158, 7, 18, 29,
+ 40, 51, 62, 73, 85, 96, 107, 118,
+ 129, 140, 147, 148, 149, 150, 152, 153,
+ 255, 6, 8, 9, 10, 11, 12, 13,
+ 14, 15, 24, 25, 26, 27, 28, 226,
+ 29, 30, 31, 32, 33, 43, 44, 45,
+ 46, 47, 48, 49, 50, 76, 77, 78,
+ 79, 80, 81, 82, 83, 84, 85, 86,
+ 87, 94, 95, 234, 181, 233, 187, 190,
+ 180, 96, 97, 98, 99, 100, 101, 102,
+ 104, 112, 182, 174, 236, 232, 229, 103,
+ 228, 226, 114, 115, 116, 117, 118, 119,
+ 120, 121, 122, 235, 176, 230, 194, 162,
+ 130, 131, 132, 133, 134, 135, 136, 137,
+ 138, 139, 201, 205, 163, 217, 220, 224,
+ 5, 248, 227, 244, 242, 255, 241, 231,
+ 240, 253, 16, 197, 19, 20, 21, 187,
+ 23, 169, 210, 245, 237, 249, 247, 239,
+ 168, 252, 34, 196, 36, 37, 38, 39,
+ 41, 42, 251, 254, 238, 223, 221, 213,
+ 225, 177, 52, 53, 54, 55, 56, 57,
+ 58, 59, 60, 61, 63, 64, 65, 66,
+ 67, 68, 69, 70, 71, 72, 74, 75,
+ 205, 208, 186, 202, 200, 218, 198, 179,
+ 178, 214, 88, 89, 90, 91, 92, 93,
+ 217, 166, 170, 207, 199, 209, 206, 204,
+ 160, 212, 105, 106, 108, 109, 110, 111,
+ 203, 113, 216, 215, 192, 175, 193, 243,
+ 172, 161, 123, 124, 125, 126, 127, 128,
+ 222, 219, 211, 195, 188, 193, 185, 184,
+ 191, 183, 141, 142, 143, 144, 145, 146
+};
+#else /* ascii rather than ebcdic */
EXTCONST unsigned char freq[] = { /* letter frequencies for mixed English/C */
1, 2, 84, 151, 154, 155, 156, 157,
165, 246, 250, 3, 158, 7, 18, 29,
130, 131, 132, 133, 134, 135, 136, 137,
138, 139, 141, 142, 143, 144, 145, 146
};
+#endif
#else
EXTCONST unsigned char freq[];
#endif
stuffing into op->op_private */
#define HINT_INTEGER 0x00000001
#define HINT_STRICT_REFS 0x00000002
+/* #define HINT_notused4 0x00000004 */
+#define HINT_UTF8 0x00000008
+/* #define HINT_notused10 0x00000010 */
+ /* Note: 20,40,80 used for NATIVE_HINTS */
#define HINT_BLOCK_SCOPE 0x00000100
#define HINT_STRICT_SUBS 0x00000200
#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*));
};
#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
* 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"
#ifndef MULTIPLICITY
-#ifndef USE_THREADS
-#include "thrdvar.h"
-#endif
+# include "intrpvar.h"
+# ifndef USE_THREADS
+# include "thrdvar.h"
+# endif
-#include "intrpvar.h"
#endif
#ifdef PERL_OBJECT
-#if defined(WIN32)
-char** environ;
-#endif
+/*
+ * The following is a buffer where new variables must
+ * be defined to maintain binary compatibility with PERL_OBJECT
+ * for 5.005
+ */
+PERLVAR(object_compatibility[30], char)
};
#include "objpp.h"
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,
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};
+EXT MGVTBL vtbl_regdata = {0, 0, magic_regdata_cnt, 0, 0};
+EXT MGVTBL vtbl_regdatum = {magic_regdatum_get, 0, 0, 0, 0};
#ifdef USE_LOCALE_COLLATE
EXT MGVTBL vtbl_collxfrm = {0,
EXT MGVTBL vtbl_defelem;
EXT MGVTBL vtbl_regexp;
+EXT MGVTBL vtbl_regdata;
+EXT MGVTBL vtbl_regdatum;
#ifdef USE_LOCALE_COLLATE
EXT MGVTBL vtbl_collxfrm;
#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. */
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
#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
*/
#define offer_nice_chunk(chunk, chunk_size) do { \
LOCK_SV_MUTEX; \
- if (!nice_chunk) { \
- nice_chunk = (char*)(chunk); \
- nice_chunk_size = (chunk_size); \
+ if (!PL_nice_chunk) { \
+ PL_nice_chunk = (char*)(chunk); \
+ PL_nice_chunk_size = (chunk_size); \
+ } \
+ else { \
+ Safefree(chunk); \
} \
UNLOCK_SV_MUTEX; \
} while (0)
+#ifdef HAS_SEM
+# include <sys/ipc.h>
+# include <sys/sem.h>
+# 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 */
-
projects / p5sagit/p5-mst-13.2.git / blobdiff